MANTLE 


A Finite Element Program for the 
Thermal-Mechanical Analysis of 
Mantle Convection 


APPENDIX E 
Program Listing 


Final Report: NASA Grant NGR 06-002-191 


by 

Erik Thompson 


Department of Civil Engineering 
Colorado State University 
Fort Collins, Colorado 80523 


May 1979 



non n n n n o n n n nnnnnnnnnnnnonnonnnnnnnon 


3 


OVERLAY(FLOWrOTO) 




THE FGLLOWIMG VALUES REPRESENT THE MINIMUH DIMENSIONS 
OF THE ARRAYS USED IN MANTLE* THE SYMBOLS $AA«r 
ETC* MUST BE REPLACED BY INTEGER VALUES* THE SYMBOLS 
IDA^ IDBf ETC. ARE FORTRAN VARIABLES THAT ARE USED IN 
THE PROGRAM TO CHECK FOR ARRAY OVERFLOW* 


«AA$ = IDA = NUMTPf WHICH MUST BE GREATER THAN NUMVP 

$BB$ = IDB = NUMTP OR MUMVP-fNUMPPr WHICHEVER IS GREATER 

$CC$ ^ IDC NUMVP 

$DD$ == IDD « NUMPP 

$EE$ = IDE == 6+NUMPP 

$FF$ = IDF = NELHT 

$GG$ = IDG = NELMC 

$11^ = IDI = MAXIMUM lELEX 

tJJ$ = IDJ = MAXIMUM LISTX 


$LL$ = IDL = KMAX 




t 

t 

t 

* 

* 

t 

* 
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PROGRAM DRIVE 

1 ( TAPES r OUTPUT ^ TAPE6=OUTPUT r TAPE? r TAPEl p TAPE2 p T APE3 p TAPE4 1 TAPES p 
2 TAPE?) 

COMHON/Cl/ 

1 XORP(«AA$> >YORD(^AA$) pXBC<*CC$) pYBC<^CC$) rTBC<«AA «) p 

2 CX < $CC$) p CY < $LC$ ) f CH<t>AAi> p TX ($CC$ > p TY < $CC$ ) f TO ( 1^AA$ ) r 

3 COSXXP ( $CC4 ) p NPBC ( $A A$ ) p NP ( p ^EE4 ) 

C0MM0N/C2/ 

1 XM IN p XMAX p YM I N p YMAX p NUMVP p NUMPP p NUMTP p NELMC p NELMT p NPPE 
CGHM0N/C3/ 

1 lELE < i $ ) p NPR < $BB$ > f LIST ( $ J J$ ) P MO VE ( $ J J$ ) p I NTO ( $ J J$ > r 

2 IDIAG(2p$JJ$) 

C0MM0N/C4/ 

1 KM AX ( 2 X p IBMAX ( 2 > p NQHAX < 2 ) p NUMSEQ < 2 ) p 

2 NSEQ p I B p L I BTX P I COMP p I ELEX p MO VEX p lEMPT 

C0MM0N/C5/ 

t IDApIDBpIDCpIDDpIDEpIDFpIDGpIDHpIDIpIDJplDKrlDLpIDMpIDNpIDOpIDP 

DIMENSION 
1 IFL0W(5) 

DATA IDA p IDB r IDCp IDD P lEE p IDF/$AA$ p $BB$ r $CC$ p $DD$ p $EE$ p <FF$/ 

DATA IDGpIDIpIDJpIDL/$GG$p$IHtp$JJ$p$LL»/ 

NTPE*A 

NVPE=6 
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c 

WRITE<6r3> 

C 

URlT£C6rl) 

READ(5t2) (IFL0 U<I)tI=1»3) 

URITE<6r2)(IFLaU<J>rI=lp3) 

C 

IF(IFL0W(1)*EQ*1> CALL OVERLAY<4HFLOU# 1 i 0) 

IF<IFL0W(1)*EC1.2) CALL GVERLAY<i»HFL0Wt2^0) 

1FCIFL0W(2>*EQ.1) CALJ* 0MERLAY(4HFL0Wf 3f 0> 

IF<IFL0U<3)*£Gl.l) CALL 0y£RLAY<4HFL0Wp4r0) 

C 

IF<IFL0W<1>*HE*7777) GO TO 7777 
C 

CALL MAP 
CALL POINT 
CALL VECTOR 
CALL LINE 
CALL FRAME 
C 

7777 STOP 
C 

1 FORMAT <10H0 IFLGW > 

2 FORMAT(SnO) 

3 format 

DATA FROM DRIVE ) 
C 

END 
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OVERLAYC FLOW r 1^0) 
FROGR^^M MESHl 


COMMON/Cl/ 

1 XORD ( $ AA« ) f YORD < $ AA* > » XBC ( $CC$ > t YBC ( ) r TBC ( ♦ AA^ > i 

2 CX ( $CCi ) r CY ( $CC$ > » CH < $ AA« > f TX ( $CCi) r TY ( liCCV ) r TO ( i AA$ ) r 

3 COSXXP < $CC$ > F NPBC ( $A A$ ) F NP < $FF$ r $EEi > 

C0MM0N/C2/ 

1 XHIN F XMAX f YMI R F YMAX » NUHVP r NUHPP r NUHTP r NELMC f RELMT f NPPE 
C0MH0N/C5/ 

1 IDATiDBfIDCrinDFiDETiDFrIDGFiDHFiDIf IDJFrDKFiriLFiDMrIDNiinOf IDP 

DIMENSION 
1 RADIUS (49) 

DATA IDQ/49/ 


WRITE(6r24> 

READ AND INITIALIZATION OF DATA 

URITE(<^f20> 

READ<5f 21) NPPE 
WRITE<6r2'^ >NPPE 

IF(NPPEFNE.0.AND*NPPE*NE*l,ANDfNPPE*NE*3> GO TO 7005 


NVPE“6 

NTPE^A 

NNPE==A+NPPE 


WRITE(6f2> 

READ<5f3) RIfROfRMfRPI 
WRITE(673)RIfR0fRMfRPI 

XMIN=-R05K1*01 

XMAX=R0iKl*01 

YMIN-^R05|il*01 

YHAX^ROilcl.Ol 

WRITE(6f1B) 

READ<5f19) IPUNCH 
WRITE(6f19)IPUNCH 


WRITE(6f7) 

READ (Sri) NDIMTHrNDIMR 
WRITE(6rl)NDIVTHrNDlVR 


WRITE<6f9) 
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READOrlOJ NPBCIf XBCI » YBCI rTBCI 
READ <5 r 1 1 ) CHI rCXI f CYI f TXI r TYI F TQI 

WRITE(6f29)NPBCI.XBCIrYBCrrTBClFCHlFCXriCYIfTXlFTYIfTai 
READ{5»10) NPBCOFXBCQFYBCQjTBCa 
READ { 5 > 1 1 ) CHO i CXO r C YD r TXO f TYO r TDD 

MRITE<&T30)NPBCOFXBCOrYBCOfTBCOFCHOF'JXOFCYOfTXOFTYOfTOO 


CALCULATE NUMBER OF NODAL POINTS 

NUMEL=ND I VTHCND I VR)K2 

NUH VP= < 25KNDI VTH ) )|t ( 2#NDIVR+1 ) 

NUMPP=0 

IFtNPPE.EO.3) NUMPP=NUHVP-(NDIVR>*(NDIUTH+1) 
IF( NPPE . EO . 1 ) NUHPP=N01 VR*NDIl.'TH 
HELHC=NUMEL 
NELMT=NUMEL 

IF(RPI,E0.2.0) GO TO liO 
NUHVP=NUMVP+2KtNDIVR+l 
IF<NPPE,EQ.3) NUMPP=NUHPP+NDIVR 
160 CONTINUE 
NUMTP=NUMOP 
NUMNP=NUMUP+NUHPP 


IF(NUMVP.GT,IDAiOR.NUMOP.GT.IDC) GO TO 7001 
IF<NUMNP.GT.1DB‘/ 60 TO 7002 
IF<NUMPP,GT.IDE) go TO 7003 
IF(NUHEL.GT.IDF,aR.NUMEL,GT.IDG) GO TO 7004 


IENB=NUMVP 

IF(NUMTP.GT.NUMVP) IEND=NUMTP 

DO 280 I=1fIEND 

NPBC(t)=l 

cosxxpa)=i,o 

XBC<I)«0.0 
YBCa)=0.0 
TBCa>s0.0 
CH<I>=0.0 
CX<I>=0.0 
CY(I>=0.0 
TX(I)=0.0 
TY<I)=0.0 
T0<I)=0,0 
XDRIia)=-0.0 
YORD<I)=-0,0 
280 CONTINUE 

CALCULATE N.P, COORDINATES AND B.C. 

R=NBIVR*2 

DX=1.P'R 

X=0.0 

IEND=NDIVR*2+1 
DO 2S0 1=1 F TEND 

RADIUS f I ) =2 . 0*<X-0 . 5 ) » (X-1 . 0 ) *RI-4 fOsCX# ( X-1 , 0 ) KCR11+2 . *X4i { X- . S) KcRO 

x=x+nx 

250 CONTINUE 
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PI=3 *141392654 
THETA=^P 1/2*0 
R=2*NDIVTH 
DTHETA=-RPlJ|cpi/R 
C 

IEND=2tNniVTH 
IF<RPI.NE*2*0) IEND«lENn+l 
JEND=^2)*tNDIVR 
ID“NDIVTH*2 

IF<RPI*NE*2*0) ID^NDIVTH)|c2+l 
C 

DO 350 I=lfIEND 
NPI=I 

C~C0S< THETA) 

S=SIN( THETA) 

P0H=1.0 

IF(S*LT.0t0J PaM=*“l*0 
C 

XBC(NPI)=XBCIJ*;P0H 

YBC(NPI)“YBCIN«POH 

TPC<NPI)=TBC1 

CH<Npn==CHI 

CX(NPI)-CXX3fJP0M 

CY(NPI)-CYI*POH 

TX<NPI)=TXI*POM 

TYCNPI>«TYI*PQH 

Ta(NPI)=^T01 

C0SXXP<NPI)=C1KP0H 

NPBC(NPI)=NPBCI 

XORD ( NPI > =R ADIUS ( 1 ) 

YORD ( NPI) =RADI US ( 1 ) #S 
C 

DO 340 J^2fJEND 
NPI=NPI+ID 

XORD < NPI ) ^RADIUS < J ) *C 
YORDCNPI)=RADlUS<J))|cS 
340 CONTINUE 
C 

NPI=NPI+ID 
XBC<NPI)=XBCO*POM 
YBCCNPi)=YBCO*POM 
TBC<NPI)«TBCO 
CH{NPI)-CHO 
CX<NPI>=CXO*PQM 
CY(NPI)==CYD*PON 
TX<NPI>-TXO*POH 
TYCNPI)^TYO*POM 
TO(NPI)=TOO 
C0SXXP<NPI)=C5|cpQH 
NPBC(NPI)"NPBCO 
JP1=JEND+1 

XORD<NPI > -RADIUS ( JPl ) *C 
YORD (NPI) -RADIUS ( JP 1 > :*tS 
THETA^THETAfDTHETA 
350 CONTINUE 

CALCULATION OF NP ARRAY 

M0P=F1 
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IEL=^0 

C 

IP«<NDIW*3)+1 

I4=NUMVP+1 

I5=I4-fNDIVR 

IA=I4+IP 

C 

DO 550 I»1^NDIVTH 

r2=Il+ID 

I3=X2+ID 

DO 540 J^IfNDTVR 
IEL=:IEL+1 

IF<M0P*LT*0) GO TO 520 
NP(IELrl)=Il 
NPaEL»2)s=Il+l 
NP<IEtr3>;=Il-f2 
NPaEL^4>^I2+l 
NP(IELf5>==I3 
NPaEL^6>=^I2 
IF(NPPE.E0*0> GO TO 510 
NPaELt7)=I4 
IF<NPPE*EQ.l) GO TO 510 
NP(IEL»7>»I4 
NP<IELr8)^I5 
NPaEL»9)=I5+l 
510 CONTINUE 
IEL=IEL+1 
NPaEL?l>=IlF2 
NP(lEtr2)=I2+2 
NP(IELf3)===I3*f2 
NP(IELf4)=I3+l 
NP<IEL/5)=I3 
NP<IELfA)^I2'fl 
IF<NPPE*EQ*0> GO TO 530 
NP<IEtr7)^I4 
IF<NPPE*EQ*1) GO TO 530 
NP<IEL»7>*I5F1 
NP(IEL»8>=I<5 
NPaELr9>=I5’f2 
GO TO 530 
520 CONTINUE 

NPdELf 1)-I1 
NP<IELr2)=Ii+l 
NPaEL^3)=Ii+2 
NPCIELt4)-I2+2 
NP(IELr5>=I3+2 
NP(IELt 6)==I2+1 
IF(NPPE.E0»O) GQ TO 525 
NP(IEL»7)=14 
IFtNPPE.EQ.l) GO TO 525 
NPCIEL»7>=I5 
NP<IEL,8>=I6 
NP<IELr9)=I5-H 
525 CONTINUE 
IEL=IEL+1 
NP<IELrl>^Il 
NP(IELr2>-I2+l 
NPaEL»3)=I3+2 
NP<IELf4)=I3-H 
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NP<I£Lr5)“J3 
NP(IELf4>=I2 
IP(NPPE*EQ*0) GO TO 530 
NP<IELr7)=I4 
rF<NPPE*E0a) GO TO 530 
WP<IELr7/=I4 
NP(IELrQ)sIS4-l 
NP<IELf9)=I5+2 
530 CONTINUE 
11=13 
I2=I1+ID 
I3=I2+ID 
I4«I4+1 
15=15+2 
16=16+1 


M0P=-H0P 
540 CONTINUE 
14 ^ 15+1 
I5=I4+NDIVR 
I6=I4+IP 

IF< NPPE* EO * 1 > I4=IANDIUR+1+NUHVP 
550 CONTINUE 


IF<RPI*NE*2.0> GO TO 571 

IBGN=NUMEL~NDXVR:K2+i 

IEND=NUMEL 

KEND=23KNDIVR+1 

DO 570 I-IBGN^IENB 

DO 570 J=lr6 

DO 569 K-a^KEND 

K1=K*ID+1 

IF(NP<Ir J) .NEfKl) GO TO 569 
NP<If J>=NP(If J)“ID 
GO TO 570 

569 CONTINUE 

570 CONTINUE 

571 CONTINUE 

READ SINGULAR BOUNDARY CONDITIONS 

WRITE<6r22> 

READ<5fl> NUNBC 
WRITE<6rl>NUMBC 

IF<NUMBC.EO.O) CO TO 761 
URITE(6»25> 

DO 760 I=lrNUHBC 

READC5f24) IlrNPBC(Il) r COSXXP< II ) v XBCi II ) r YBC< IX ) f TBC(I1 ^ 
READ (5f 27) CH< II ) r CX< ID rCY( II ) fTX< II > r TY ( 1 1 ) f TQ < II ) 
WRITE(6r2B) IlrNPBC(Il) i COSXXPai) »XBC(ID fYBC<Il> r TBCCID r 
a CH<ID ^CXCIDfCYdl) fTX<Il)»TY<Il)rTQ(ID 

760 CONTINUE 

761 CONTINUE 


701 CONTINUE 
C 

CALL MSHADJ 
C 
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OUTPUT OF DATA 
WRITE<6f1A> 

WR I TE ( 6 7 1 7 > NUHNP r NUMTP f NUM VP f NUMPP f NELMC r NELHT 
URITE<6f12> 

DO 820 I^^IfNUMTP 

URITE(6rl3) iFXaRDCI) f YORD( I ) fNPBC(I > fCOSXXP<I) rXBC( I ) f YBCd > f 
1 TBCa>FTX(I>FTY<I)FTCKI)^CH(I>FCX<I)FCY<I) 

C20 CONTINUE 

WRITE<Af1^> 

DO 840 I*=1fNUMEL 

WRITE<6f15) If (NP(IfJ) fJ=1fNNPE> 

840 CONTINUE 

IF<IPUNCH.NEf7> GO TO 855 

WR 1 TE < 7 F 1 7 ) NUMNP f NUHTP r NUH VP f NUMPP r NELMC j NELMT 

DO 845 I=-1fNUHTP 
WRITE(7f 13) IrXORD(I>FYORD<I> 

845 CONTINUE 

DO 850 I=1fNUMEL 

WRITE(7f15> If<NP<IfJ)fJ=1fNNPE) 

850 CONTINUE 
855 CONTINUE 

CALL MAPtXMINFXMAXFYMINFYMAXFO.OFl.OFO.OFlfO) 

DO 860 I:=1fNUM£L 
I1«NP<If1) 

I2=^NP<If2) 

I3=NP<If3) 

I4“NP(If4) 

I5==NP(If5) 

I6^NP<If6) 

CALL P0IiNT<X0RDCI1)fY0RD<I1>) 

CALL VECT0R<XQRD(I2)FY0RDa2)) 

CALL VECTOR<XORDCI3> fY0RD<I3)> 

CALL VECT0R(X0RD<I4>FY0RDa4)> 

CALL VECT0R<XaRD(I5>FY0RD(I5>) 

CALL VECT0R(X0RD(I6) fY0RD<I6)) 

CALL VECTOR<XDRDCin rYORDCID) 

860 CONTINUE 
CALL FRAME 


GO TO 7777 


ERROR MESSAGES 

7001 URITE<6t 5) NUMVPrlDArlDC 
STOP 

7002 WRITE<6f6) NUMNP fIDB 
STOP ' 

7003 WRITE<6f4) NUHPPfIDE 
STOP 

7004 WRITEC6r8) NUMELfIDG 
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STOP 

7005 WRITE(6r23> 
STOP 


FORMAT STATEMENTS 


1 F0RMAT(8I10) 

2 FORMAT <-^0H0 RI RO RM RPI ) 

3 F0RMATC7E10435 

A FORMAT(i4HO NUMPP ERUALSrI5r 22H EXCEEDS DIMENSION IDEf I5> 

5 FDRMAT(14H0 NUMUP EQUALS, 15, 26H WHICH EXCEEDS EITHER IDAr, 
i I5r QH DR 1 DC,fI5 ) 

6 FORMAT (14H0 NUMNP EQUALS, 15, 20Hr WHICH EXCEEDS IDD,,IS) 

7 FDRMAT(20HO NDIVTH NDIUR > 

ti FORMAT(1>1HO NUMEL EQUALS, 15, 27H, WHICH EXCEEDS EITHER IDF,, 

1 15, 8H DR IDG, 15) 

9 FORHATdOOHO NPBC XBC YBC TBC / CH 

1 CX CY TX TY TQ > 

10 F0RHAT(I10,3E10*3) 

11 F0RMAT(4E10*3> 

12 FORMAT(127HO NP XORB YDRB NPBC C05XXP XBC Y 

IBC TBC TX TY TQ CH CX 

1 CY ) 

13 F0RMAT(I5,2El0*3rI5,F74^,9E10*3) 

14 F0RMAT<40H0 ELEM NP ) 

15 FORMATdOI?) 

16 FORMAT <60H0 NUMNP NUMTP NUMUP NUMPP NELMC N 

lELMT ) 

17 FORHATtSIlO) 

18 FORMAT CIOHO IPUNCH > 

19 FORMATdlO) 

20 FORMATdOHO NPPE ) 

21 FORMATCnO) 

22 FORMAT d OHO NUMDC) 

23 F0RHAT(35H0 NPPE MUST EQUAL EITHER 0, 1, DR 3 ) 

24 FORMAT<2UO,F10*4r5E10»3) 

25 F0RMAT(123H0 NP NPBC CDSXXP XBC YBC 

1 TBC / CH CX CY TX TY 

ITQ ) 

DATA FROM MESH ) 

27 F0RMAT(6E10.3) 

2S F0RMAT(2I10,F10*4f3E10.3, 3H / ,6E10*3 ) 

29 FORMATdlO, 9E10*3, lOH INSIDE ) 

30 FORMATdlO, 9E1043, llH OUTSIDE ) 

C 

7777 CONTINUE 
END 
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OVERLAY<FLOUf2rO) 
PROGRAM MESH2 


COMMQN/Cl/ 

1 XORIi ( $ AA$ > r YORD ( $AAi ) » XBC < $CC$ ) r YEtC < SCCi ) f TBC ( $ AA$ ) ^ 

2 CX<$CC$)%CY($CC^)rCH(iAAi>fTXHiCC$)FTY<iCC$J FT«<iAA$> r 

3 C0SXXP(*CC«)fNPBC($AAi>FNP(4FF$F$EE$) 

C0HM0N/C2/ 

i XMIN F XMAX F YMI N F YMAX . NUHVP f NUMPP f NUHTP f NELMC f NELM I r NPPE 
C0Hv10N/C5/ 

1 ICAFlDBFlDCFlDDFlDEFlDFFlDGFlDHFlDlFinjrlDKFlDUFlDHFlDNFlDOFlDP 
DIMENSION 

1 ND1V(5f 4? rJOINtSf 4 f2> fXCDR(5f8) f YC 0R(5rB) fLNP(?f4f 100) f 

2 LPDC<5f4)fXLBC(5f4>fYLBC(5»4) fCXLBC(5»4) fCYLBC15f4) fTXLBC( 5r 4 ) f 

3 TYLBC(5f 4) FTGLBC(5r4) fTLBC(5f4)FCHB0\5F4> fC0SLBC(5f4) F 

4 LNR<4FlOO)fNPN<i^BB$>fRN<8)FNU«LPSt ' . 


WRITE v6f 26) 

READ AND INITIALIZATION L. - T* 

WRITE<6»20> 

READ<5f21) NPPE 
WRITE(6f21)NPPE 

IF<NPPE*NE.0,AND-NPPE*NE,1*AND*NPPE»NE*3) GO TO 7001 


N0PE^6 

NTPE=6 

NNPE==6+NPPE 

WRITEC6f2> 

READ<5f 1) NUMLPSa)FNUMLP3(2> 
WRITE ( 6 f 1 > NUHLPS (1 ) f NUNLPS ( 2 ) 


IEND=NUMLPSC2) 
DO 120 I“1fIEND 
DO 120 J=1f4 
LPPC<IfJ)= 1 
XLBCarJ)=0,0 
YLBC<If J)=O tO 
TLBCaFj>=0.0 
C0SLBC<IfJ)= 1.0 
CHBCCXr J)=0*0 
CXLDC<Ir J)=:0,0 
CYLDC<If J>«0*0 
TXLBC<I» J)-0.0 
TYUBC<IfJ)-0.0 
T0LBCaFJ>=^0*0 
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120 CONTINUE 
C 

WRITE(<4r4) 

REAti<5»3> XHiNrXKAXfYhINfYMAX 
lJRITE(6r3)XMIN»XMAXTYMINrYiiAX 
C 

READ(5rl9> IPUNCH 
WRITE(Ar 19)IPUNCH 
C 

IENn=NUHLPS(2) 

DO ISO I=lfIEND 
URITE(6-S) I 
UpITE<«Sf7) 

RLAD<5r6) NOIVarl) rNDIV(l72) 

WRTTE(6T6)NDlV(If 1) rNDIV<I>2) 

C 

WRITE<6f8) 

READC5f9) ((JDXNCif JrK>iK=lf2>Tj«l»4> 
gRITEC6r9X<J0IN(IrJfK>TK^lf2) 

C 

WRITE<6f 10) 

READ(5rll> <XCORafJ> YCOR (I f J ) f J=1 r 3 ) 

WRITE<Af llXXCORaru f YCOR< 1 y J > y J=1 p B ) 

C 

WRITE<6y22) 

READ(5rl) NUHBC 
WRITE(6fl)NUHBC 
C 

IF(NUNBC.EQ*0) GO TO 131 
C 

WRITE<6r23) 

BO 130 J=1»NUMBC 

REAIlC5r24) JlrLPBC(TyJl>yCOSLBC(IyJl> yXLBC(IfJl) FYLBCdf J1>F 
1 TUJCCIfJI) 

READ<5y27> CHBCCI rJl > fCXLBC( I rJl ) rC/LBCd fJl > yTXLBCCI yJl > y 
1 TYLBCdr Jl) pTQLBCdyJl) 

WRITE<6y28) Jl y LPBC d r Jl ) y COSLBC< I r Jl) r XLBC <1 y Jl > f YLBC ( 1 r Jl > r 
1 TLBCdy Jl) yCHBCdy JDrCXLBCdyJDyCYLBCdf Jl) rrXLBC(IyJl) r 
1 TYLBC<IyJl)yTOLBC<IyJl) 

130 CONTINUE 
C 

Iwi CONTINUE 
C 

150 CONTINUE 
C 

rENB~NUMLPS<2) 

DO 160 I^^^lrlEND 
NBIVdy3)-NDIVCIyl) 

NDlV(Iy4)^NnrOCIr2) 

160 CONTINUE 

CALCULATE NUHBER OF NODAL POINT'S 

NUMTP=0 
NUHVP=D 
NUMPP^O 
IENB“NUHLPS(2> 

DO 260 1=1 f TEND 

I7=<2*NDlVCIyl)+l)3|c<23|fNDIUdr2)il) 
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IF(I*GT.NUHLPB(1)) GO TO 230 

lF<NPPt:,E:a»3) I0=I7-(NDIV(Ir l>^n*(NDIVCIf2) + l) 
IF(NPPE.EQ*1) Ifl=NUIV(I»l>*Nl]iIV<Ir2) 
IF<NPPE*EO.O> ia=0 
C 

NU«VP=NUWP+I7 
NUMPP^NUMPP+ia 
230 CONTINUE 

NUHTP=NUMTP+I7 

C 

Jl=4 

DO 250 J-lfA 

IF(JOIN<IrJrl)*EQ.O) GO TO 24? 

NUMTP^NUMTP- (2)|tNDIV< I f J>+1 ^ 

IF< JOINCI f J1 f 1 > .NE , 0> NUMTP*=NUMTP+1 
IF<I*6T*NUHUPSC1) ^ 60 TO 24? 

NUMMP=NUMUP- ( 2*NDI V ( I » J ) +1 ) 

IF ( NPPE ♦ EQ • 3 > NUMPP«NUMPP- ( NDIV ( I r J> ) 
IFCJ0IN(l7Jlft) .NE.O> NUMVP=NUMVP+1 
24? CONTINUE 
J1=J 
C 

250 CONTINUE 
2A0 CONTINUE 
C 

NUMN'^=NUMVP+NUHPP 
IFCNUMTPtOTtNUMNP) NUMNP^NUNTP 
C 
C 

IF(NUMTP*GTfIDA*OR*NUMVP*GTaDA> GO TO 7002 
IF<NUMNP*GT*IDB> GO TO 7003 
IF<NUMW*GT^IDC> 60 TO 7004 
IF<NUfiPF%GT.IDD) GO TO 7005 
IF(NELMT*GT*IDF> GO TO 700A 
IF(NELMC*GT*IDG> GO TO 7007 
C 

c 

lENBv^NUMUP 

IF(NUMTP.GT.NUMUP) lEND^NUMTP 
DO 280 I*l7lEND 
NPBCU)=1 
COSXXP(I)=i,0 
XBC<I>=0.0 
YBCa>=0*0 
TBC<I>=0*0 
CH<I)=OtO 
lX< 1)==0.0 
CY(I)=0*0 
TX<I)=0*0 
TYa>=0.0 
TOCI)“0.0 
X0RD(I>=“0.0 
YORDCD^-O^O 
280 CONTINUE 
C 

ITP=0 

IUP“0 

IPP--^NUHOP 

IEL=0 
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lELC^O 

DFACT^0*001 

C 

IEND=NUMLPSC2> 

DO 720 I=:lrIEND 
C 

n^^NDIOdf 1) 

12=2*11+1 

13-3*11+1 

C 

I4=NPlV(Ir2> 

T5=2*I++1 

iA«3*r^+i 

c 

17=12*15 

IF<NPPE*EQ*3) IQ=I7-<Il+l)*(I4+i) 
IFCNPPE.EQd) IB=I1*I4 
IFCNPPE.E0*0) 18=^0 
jCF(I*GT*NUMLPS(1)> 18=0 
19=17+18 

CALCULATE SIDE ARRAYS 
JEND=I2 


J2=I7-I2 

J4=I2+1 

DO 320 J=1»JEND 
J^=J+"1 
LUR(l7J)=J 
LMR<3rJ+)=J2+J 
320 CONTINUE 

IFCNPPE.NE*3) GO TO 331 
IF<I*GT4NUMLPS<D) go to 331 

JBSN=JEND+1 

JEND=JEND+I1 

Jl=a7+1>*«JDGN 

J2=: < I7+I8“1 1+1 )-JB6N 

J4=I3+1 

DO 330 J=JBGNrJEND 
J+=J4"1 
LNRUt J)=J1+J 
LNR(3r J+)=J2+J 

330 CONTINUE 

331 CONTINUE 


JENi;i=I5 

c 

J4=I3+1 

00 340 J=lrJEND 
J4=J4^1 
LNR(2r J)=J*I2 
LNR(4f J4>=CJ-1>*I2+1 
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340 CONTINUE 
C 

ir<NPPE*NE.3> CO TO 355 
IF(r,GT*NUNl.PS(i)) GO TO 355 


JBGN«JEND+1 

JEND^JENDflA 

Jl^l 

J4=I6+1 

no 350 J^JBGNfJEND 

LNR(2f J>*=I7+JlJ|{(n-fI2) 
LNR<4f J4)=LNR(2f J)“I2+1 

350 CONTINUE 

355 CONTINUE 


CALCULATE NPN ARRAY 
JEND==I9 

DO 415 J^l^JEND 
NPN<J)=0 
415 CONTINUE 

DO 440 J-lr4 

IF<JOIN(IfJ»1),EQ.O) go to 440 

Jl=JOINa* J»i) 

J2=:JOIN<If Jf2) 

KEND=2JKNDIU(Ir J)+l 
K2=KEND+1 

DO 425 K~1fKEND 
Kl=LNR<JrK) 

K2=K2-*1 

NPN ( K 1 ) ^LNP U1 F J2 F K2 ) 

425 CONTINUE 

IE(NPPE.NE*3) GO TO 440 
ir<r.GT;NUMLPS(l)) GO TO 440 


KBGN=KEND4*1 

KEND“3*NDIV(I»J>+1 

K2=KEND+1 

C 

DO 435 K=KDGNrKEND 
K1=LNR( JfK) 

K2=K2-1 

NPN<Kl>=LNP(Jlf J2 fK2> 
435 CONTINUE 
C 
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^AO CONTINUE 
JEND=I7 

DO AM J^lrJEND 
IF(NPN(J>*NE*0) GO TO A60 
ITP=ITP+1 
NPN( J)>=ilTP 

IFa*GT*NUMLPS<l>) GO TO A60 
IW=1VP+1 
^60 CONTINUE 


IF(I*GT»NUMLPS(1>) 60 TO 471 

jeON~JEND+l 

JEND==I9 

tiO 470 J=JBGNrJEND 
IF<NPNU> .NE.0> GO TO 470 
IPP==IPP+1 
NPH<J>«IPP 

470 CONTINUE 

471 CONTINUE 


IF(NPPE*EQ*3> J6ND=I3 
IF(NPPE*NEt3> JENn^I2 
IF<I.6T*NUHLPS(1>> JEND=I2 

t(0 485 J=1»JEND 
Jl=LNR<ir J) 

J3=LNR<3> J> 

LNPCIrlr J)^NPN<J1) 
LNP<lT3t4)=NPNCJ3) 

485 CONTINUE 

IF<NPPE.EQ*3) JEND^IA 
IF(NPPE*NE*3) JEND=I5 
IFa»GT»NUMLPS<l>) JEND-I5 

DO 4S7 J=lfJEND 
J2-LNR(2r J> 

J4=LNR<4f J) 

UNPa^Or J)“NPN(J2) 
LNPCIr4?J)=NPN<J4) 

487 CONTINUE 


FORMULATE BOUNDARY CONDITIONS 

DO 49S J=lf4 
KEND=I2 

IF(J*E0.2.0R.J*EQ.4> KEND=I5 

DO 495 K^XtKEm 
Kl=LNP<If JfK) 
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MPBC ( LNP ( I r J # K ) ) =LPBC < I r J > 
COSXXP ( LNP < I r J r K > ) =COSLBC ( I f J ) 
XBC(LNF(If JrK)>=XLBC<lr J) 
VBC<LNP(Ir J>K))sYLBC(IrJ) 
TBC(LNpaiJTK>)=TLBC<IiJ) 
CH<LNP<Ir J tK>>^CHBC<IfJ) 
CX<LNP<ItJfK>>=CXLBC(IfJ) 
CY(LNP<Ir JfK) .^CYLBCdf J) 

TX (LNP C I r J r K> ) =TXLBC ( I f J> 
TY(LNPflFJFK))^TYLBcaFJ> 
TR(LNP<Ir J fK))=TQLBC<I»J> 

495 CONTINUE 


CALCULATE NODAL POINT COORDINATES 

BX=1*0/R 

R=2#I4 

»Y=^1*0/R 

JEND=I5 

KENB=I2 


K1=0 


BO 550 J==1fJEND 

R=J-1 

RY-R«DY 

DO 540 K-IfKENB 

R=K-1 

RX=*R*DX 

RN(1 >=4-1.01? (l*0-RX>J|fa*0^RY)*<1.0^2«0#RX~2*0J»:RY> 
RN(2>=-J-4.0*CRX>1{(1.0-RX)*(1.0-‘RY) 

RN ( 3 ) =-l . Olf < RX ) # a • 0-R Y > * a * 0-2 . 0*RX+2 . 0#R Y ) 

RN<4)=-f4.01?(RX)1f(RY)l:<1.0-RY> 

RN(5)--1*OKCRX)*<RY>*(3.0-2.0*RX"2.01?RY) 

RN(A>«+4.01?<RX>*(1.0-RX>Jif<RY> 

RN<7)=-l»O#a*0-RX>1f{RY)}ifa.0'f2.03HRX-2*0l:RY) 

RN(8)^+4.01c(l*0-RX)*(RY>1f(1.0“RY> 

K1=K1+1 

K2=NPN(K1) 

XORDm^2)-0.0 
Y0RD(K2>-0*0 
DO 530 L=1 f8 

XOR D < K2 > =XORD ( K2 > +RN ( L ) 1?XC0R ( I f L ) 

YORB < K2 ) - YORD ( K2 ) +RN ( L > 1? YCOR < I f L> 

530 CONTINUE 

540 CONTINUE 
550 CONTINUE 

CALCULATION OF NP ARRAY 


JENI*=I4 

KEND=I1 
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c 

DO 660 J=irJBHB 
DO 650 K-1tKEND 
C 

IEL=:IEL+2 

IF<I.LE*NUMLPSa)> IELC^=IELC+2 
N1«IEL“1 
N2«IEL 
C 

Kl = (J-l>J|e25ia2+CK-i>3J<2+l 

K2-K1+1 

K3«Kl+2 

K4=sKl+I2 

K5«K4-H 

K6«K4+2 

K7=Klf2J|ci2 

K8-K7*M • 

K9=^K7+2 

IF(MPPE*EQ.3) K10=(J‘-l>Jia3+I7-fK 

IF(NPPE,EQtl> K10-CJ-'1)*I1+I7+K 

IF<NPPE,EG-0) K10«0*0 

IF(I*GT.N'JrtLP8a)) KIO^O 

Kll^KlO-fll+K-i 

K12=KU+1 

K13=KU+2 

C 

K1=NPN<K1> 

K2^NPN(K2) 

K3«NPN<K3> 

K4-NPN<K4> 

K5=NPN<K5> 

K6»NPN(K6) 

K7==NPN<K7> 

K0=»NPN<KQ) 

K9=*NPN<K9) 

K 10 =NPNUao> 

K11==NPN(K11) 

K12-NPNCK12) 

KJL3=»NPN(K13) 

K14=NPN<K14) 

C 

Dl= < XORD < K9 ) -XORD ( K1 > ) *3J«2+ ( YORD < K9 > ~ YORD < K1 > ) 

D2== < XDRD < K7 ) -XORD ( K3 > > < YORD < K7 > YORD ( K3 ) ) *#2 

C 

Dl^Dl+DFACT:|fDl 

DFACT=”1*0*DFACT 

C 

c 

IF<D2*LT*DX) GO TO 630 
C 

NP(Nlfl)-Kl 

NP<Nlf2>s^K5 

NP(Nlr3)=K9 

NP(N1»4)=K8 

NP<Nlr5)=K7 

NP<NIf6)=K4 

NP(Nlr7>=K12 

NP<NlrS)=Kl4 

NP(Nlr9)n=Kll 
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IF(NPPE*EQ4l> NP<Nif7)=K10 
C 

NP(N2fi>=Kl 

NP(N2f2)-K2 

NP(N273):=K3 

NP(N2i4)»K6 

NP<N2f5J»K9 

NP(N2f6)=K5 

NP<N2f7)=K10 

NP(N2fQ)=K13 

NP<N2f9)-K12 

C 

GO TO 650 
630 CONTINUE 
C 

NP<N1f1)=K1 
NP(N1f2)=K2 
NP(N1f3)=K3 
NP CNIf 4 >^K5 
NP<N1f5)*=K-7 
NP(N1f 6>=K4 
NP<Nlf7>=K10 
NP<N1 t 8)=K12 
NP(Nlf9)“Kll 
C 

hP(N2»l>=K3 

NP<N2f2)=K6 

NP(N2f3>-K9 

NP<N2f4)==K8 

NP(N2f5)=K7 

NP(N2f6)=K5 

NPCN2y7)“K13 

NP<N2f8>“K14 

NP(N2r9)=K12 

IFCNPPE^EG*!) NP(N2f7>=K10 
C 

650 CONTINUE 
660 CONTINUE 


720 CONTINUE 
NELMT-IEL 
NELMC=IELC 
NUMEL-NELHT 

READ SINGULAR BOUNDARY CONDITIONS 

WRITE(6f22) 

REAIKSfI) NIIMBC 
WRITE<6f1)NUMBC 

IF(NUMEC.EO.O) GO TO 761 
WRITE(6f25) 

DO 760 I^lrNUMBC 

READ<St 24> IlrNPBCilD/COSXXPCIl) rXBCCin fYBCdl) fTBCCll) 
READC5.27) CH( II ) »CX( II > rCY( II ) fTX(I1 ) fTY( II > f TQ dl > 
WRITEC6 f28) IIfNPBC(II) fCOSXXP(II) »XBC<I1> fYBC(I1)fTBC(I1 ) f 
1 CH(ii) fCX(ii) FCYai)fTxai)FTYai)fTo<in 

760 CONTINUE 

761 CONTINUE 
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IF(NPPE*EQ*0> GO TO 7B1 

if'<nelht»le:.nelmc) go to ?si 

IBGN=NELMC+1 
Ji^GN^NUPE-fl 
JEND=NUPE+NPPE 
no 700 r^^IBCNfNELHT 
DO 700 J^JBGN/JEND 
WP(IrJ>=0 

780 CONTINUE 

781 CONTINUE 

CALL NSHADJ 


OUTPUT OF DATA 
WPITE(6rl6> 

URI TE ( 6 p 1 7 ) NUNNP p NUHTP f NUM VP r NUMPP p NELMC p NELMT 
URITE<Af12) 

DO 020 I=1tNUMTP 

URITE<6t 13) IfXORD(I)TYORDCI) fNPBC(T>tCOSXXP(I) fXBC(I)fYBC(I) r 
1 TBC<I) rTX(I) fTY<I)pTQ(I) rCH(I) rCX<nrCY(I) 

020 CONTINUE 

URITE(6f14) 

DO 840 I=lrNUhEL 
Wf?ITE(6rl5) Ir (NPCIfJ)»J=1pNNPE) 

B40 CONTINUE 

IF(IPUNCH.NC.7) 60 TO 8S5 

WR ITE ( 7 7 1 7 ) NUHNP r NUHTP r NUHUP t NUMPP r NELMC p NELMT 

no 845 I=1 pNUMTP 
URITE<7fl3> IpXORBa>rYORD(I> 

845 CONTINUE 

DO BSO I^lfNUMEL 
WRITE(7rl5) I p (NP Cl p J > p J=1 pNNPE) 

050 CONTINUE 
855 CONTINUE 

CALL MAP(XMrNpXiiAXfYHlNrYMAXpO*Opl*OpO.Of 1*0) 

BD 060 I^ItNUMEL 
Il=NP<Irl) 

I2^-=;NP<Iy2) 

I3-NPCIp3> 

I4=^NP(Ip4> 

I5=NP<Ip5) 

I6=NP(rr6) 

C 

CALL POINTCXORDCIDpYDRDCII)) 

CALL VECT0R(X0RBa2) rV0RD(I2)) 

CALL yECTORCXORDClS) rY0RD(I3)) 

CALL VECTOR CXORDC 14 )pYaRD< 14 ) > 

CALL VECTOR (XQRDC IS ) pYDRBC 15) > 

CALL 'VECT0R(X0RD<I6) tY0RD(I6>) 

CALL VECTOR<XDRn<Il>,YORD(Il>) 

S60 CONTINUE 
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CALL frame: 


GO TO 7777 


ERROR MESSAGES 


7001 URITE(6r29> 
STOP 

7002 WRITE(6f30) 
STOP 

7003 WRITE(6f31) 
STOP 

7004 WRITE<6»32) 
STOP 

7005 WRITE(6r33) 
STOP 

7006 WRITE(6f34> 
STOP 

7007 URITE(6r35> 
STOP 


NUMTPrNUMOPrIDA 

NUMNPfIDB 

NUMVPtIDC 

NUMPPfIDD 

NELMTfIDF 

NELMCrlDG 


FORMAT STATEMENTS 


1 FORMAT<ano> 

2 F0RMAT<20H0NUMLPS(1> NUMLPS(2> > 

3 FORMAT (7E10 *3) 

4 FDRMAT<4OH0 XMIN XMAX YMIN YMAX ) 

5 F0RMAT(//rl2H LOOP NUMBER f IS) 

6 FORMAT (2110) 

7 F0RMAT(20H0NDIM<Ifl) NDI0ar2> ) 

8 F0RMAT<20H0 JOINdrJrK) ARRAY ) 

9 F0RMAT(4<I7fI3)> 

10 FORMAT (20H0 XCOR YCOR ) 

11 F0RMAT<2E10*3) 


12 FORMAT (127H0 

NP 

XORD 

YORD NPBC 

COSXXP 

XBC 

IBC TBC 

1 CY ) 

TX 

TY 

TQ 

CH 

CX 

13 FDRMAT<I5f2E10*3fI5fF7 

.4f9E10.3) 




14 F0RMAT(40H0 

15 FORMAT (1017) 

ELEM 



NP 

) 

16 FORMAT (60H0 

NUMNP 

NUMTP 

NUMUP 

NUMPP 

NELMC 

lELMT > 

17 F0RMAT(8I10> 

18 FORMAT (lOHO 

IPUNCH 

) 




19 F0RMAT<I10) 

20 FORMATdOHO 

NPPE ) 





21 FORMAT (110) 

22 FORMATdOHO 

NUMBO 





23 FORMAT (123H0 

SIDE 

BC 

COSXXP 

XBC 

YBC 

1 TBC / 
ITQ ) 

CH 

cx 

CY 

TX 

TY 

24 F0RHAT(2I10FF10*4tSEl0 

.3) 




25 f='0RMAT(123H0 

NP 

NPBC 

COSXXP 

XBC 

YBC 

1 TBC / 

CH 

CX 

CY 

TX 

TY 


ITQ ) 
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26 f ORHAT ( 

DATA TROM MESH ) 

27 F0RMAT(6E10*3> 

2B FORHAT<2I10^F10t4f3E10*3F 3H / y6E10*3 > 

29 F0RHAT<35H0 NPPE MUST EQUAL EITHER Or It OR 3 ) 

30 FORMAT<BHO NUMVPr r 14r lOHrOR NUHTPr r I4r21H IS GREATER THAN IDAr 
1 »I^> 

31 F0RMAT<1AH0 NUMNP EQUALS r 15 r2BHr WHICH IS GREATER THAN IDBiflS) 

32 FORHAKl^HO NUMVP EQUALS r IS r28Hr WHICH IS GREATER THAN IDCrrXS) 

33 FORMATd^HO NUMPP EQUALS r 15 r26H» WHICH IS GREATER THAN IDDrrIS) 

3^ FORMAT a 4H0 NELHT EQUALS j» IS » 2BHr WHICH IS GREATER THAN IDFrrlS) 

35 F0RMATU4H0 NELHC EQUALSr ISr 28Hr WHICH IS GREATER THAN IDGrrIS) 

7777 CONTINUE 
END 
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0yERLAY(FL0WT3f0> 

PROGRAM WAVE 
C 

COHHON/Cl/ 

1 XDRD < ifc AA« > r YORD ( A* > f XBC ( $CC$ > , YBC ( f CC» ) r TBC < iA A$ ) ^ 

2 CX<iCC$>fCy<$CC$>rCH(»AA*)fTX(*CC$> rTY($CC*) rT«<«AAi)f 

3 CQ3XXP(i^CCi>fNPJSiCC$AA*) rNPC$FF$fiEE$> 

C 

C0MM0N/C2/ 

1 XM I N r XH AX t YMI N r YM AX r NUHVP f NUMPP r NUMTP r NELHC f NELHT f NPPE 
C 

COMMON/C';/ 

1 lELE NPR < $BB$ ) r LIST ( $ J J$ ) » HQ VE ( tJJt ) r INTO ( ♦ J J* ) r 

2 IDIAG(2TiJJ$) 

C 

C0MM0N/C4/ 

1 KMAX ( 2 ) T I BMAX < 2 > r NQM AX < 2 ) r NUMSEG ( 2 ) r 

2 NSEO F I B r LI SIX I ICOMP f I ELEX t MO VEX r I EHPT 
C 

CQMM0N/C5/ 

1 IBAFlDBFinCrlDBflDErlDFrinGFlDHFlBlFlBJflDKFlDLFlDHf IDN fIDOfIIiP 
C 

DIMENSION 

1 lORDER C 2f * FF$ ) f LSTCP C $ J > f LSTIC t $ JJ$ ) r LSTOLB ( ♦ JJ* > f 

2 NPIX($BB$)fMSHCDC2> 

C 

NTPE=4 
NVPE«6 


WRITE(6f20) 

REWIND 1 
REWIND 3 

WRITE(Arl9) 

READ(Sf4> MSHCDa>rMSHCD(2) 

WRITE t6F4)MSHCD(l>fMSHCDC2) 

DO 1000 I0«lf2 

IF<MSHCD<IO> *Ea*0) GO TO 1000 

WRITE(6f27) 10 
NNPE«NVPE+NPPE 
NUMNP^NUMVP+NUHPP 

numel-nelmc 

IFdO^EQ*!) GO TO 120 
NUMNP=NUMTP 
NUHEL-NELMT 
NNPE=NTPE 
120 CONTINUE 

FORMULATE NPIX ARRAY AND INITIALIZE NPR ARRAY 

DO 130 I==1fNUMNP 
NPIX<n=^0 
NPR<I)=0 
130 CONTINUE 
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DO X35 l-irmmL 
DO 135 J^lrNNPE 

NPIX<J1)==NPIX(J1)+1 
135 CONTINUE 

lh<NUHNP.EO.NUMVP) GO TO 138 
IF<I0tEa*2) GO TO 139 

IBGN»NUMUP+1 
DO 137 l^^lBGNrNUMNP 
NPIX ( r ) =:NVPE*NPIX ( I ) 

137 CONTINUE 

138 CONTINUE 

URITE(6p15> 

REAH<5f4) HAXVOLtIBMIN 
UpITE(AF4)MAXV0LrIBMIN 

DO 140 I=1fNUNEL 
IORDER(IOpI)^I 
140 CONTINUE 


WRITECAf 10) 

READ(5f4) I read 
WRITE(6r4)IREAD 

IF(IREAD*NE»5> GO TO 150 

READ ( 5 F 1 1 > (I ORDER < 10 1 1 ) f 1 r NUMEL) 
150 CONTINUE 

WRITE<Af12) 

WRITE < 6 F 1 1 > < lORDER C IO f I ) r 1=1 f NUMEL > 


CHECK TO SEE IF ALL ELEMENTS ARE ACCOUNTED FOR 
(TEMPORARY USE OF NPR ARRAY ) 


DO 160 1=^1 F NUMEL 
NPR(I)=1 
160 CONTINUE 

DO 165 I=1fNUMEL 

I1=I0RDER(I0fI> 

NERdD^NPRai)-! 

' ^5 CONTINUE 

DO 170 I=1fNUMEL 
IFCNPR(Il) .NEiO) GO TO 7004 
170 CONTINUE 


FORMULATE TAPE SEGMENTS 


INITIALIZE 
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DO 230 
LIST(I)=0 
LSTCP<n=0 
LSTIC(I)*0 

230 CONTINUE 
C 

DO 231 
IEUE<I>=0 

231 CONTINUE 


NUMSE0(I0>«0 

IBMIO^IBHIN 

NQHIO^O 

LSTICX==0 

LSTCPX-0 

ID0LD«=0 

IELEX=0 

IEHPT=0 


URITEC6f9) 

DO 900 I=lrNUMEL 

Il=I0RDER(I0rI> 

IELEX«IELEX+1 

lELECIELEX)^!! 

PLACE NEU NODAL POINTS IN LSTIN 
DO 330 J=1tNNPE 

IF<J1>GT.NUMOP*AND»IO*EO»1) QO TO 320 
NPIXCJ1>=NPIX<J1)‘-1 
320 CONTINUE 
KEND-LSTICX 

IF(KEND*EQ.0) go to 326 

DO 325 K=1^KEND 
IMJ1*EQ,LSTIC(K)) go to 330 

325 CONTINUE 

326 CONTINUE 
LSTICX^LSTICXFl 
LSTICtLSTICX>^Jl 

330 CONTINUE 


TRANSFER COMPLETED N*P* TO LSTCP 


335 CONTINUE 
1PCHK=0 


C 


JEND^LSTICX 
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DO 360 J-lfJEND 
340 CONTINUE 
J1“LJ>TIC(J> 

IF(Jl*E0t0) 00 TO 360 
IF<NPIX(J1)*GT»0> GO TO 360 

IF(I0..E0.2) CO TO 348 
IF<NUMUP.EO*NUMNP) GO TO 34B 
IF<JltGT.NUMVP> GO TO 340 

DO 345 K=^lfl 
M^^IORnERdrK) 

L*! 34S L=lr NOPE 
L1=NP(K1 pU 

IF(Ll.NE.Jl) GO TO 34S 
HBGN-NMPE+1 
DO 343 M-HBGNrNNPE 
Ml^NP<Klfli> 
NPIX<Ml)*=NPIX(Hi)-l 
343 CONTINUE 
345 CONTINUE 


IPCHK=1 

34B CONTINUE 

USTCPX^=LBTCPX+1 

LSTCPCLSTCPX>i^Jl 

DO 350 K=JfLSTICX 
LSTIC(K>=LSTIC(K+1) 

350 CONTINUE 

LSTICX=LSTICX-1 
GO TO 340 
360 CONTINUE 

IFdPCHK.EQ.l) GO TO 335 


CALCULATE NPR ARRAY 

DO 375 J“1,NUMNP 
IFCNPR< J> .EtU-1) GO TO 375 
NPR<J)=0 
375 CONTINUE 

DO 385 J“lrLSTCPX 
J1=^LSTCP( J> 

NPR(J1)=J 
385 CONTINUE 

IF(LSTICX*EQ*0) GO TO 388 
DO 387 J=lfLSTICX 
J1==LSTICCJ) 
NPR<Jl>=JtL5TCPX 
387 CONTINUE 
3BB CONTINUE 
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CrtLCUU/UE CURRirNT ID 
ID=0 

DO 430 J=liNUMEL 
DO 420 K=lrNNPE 
Kl=NP(JrK) 

K2=NPR<K1) 

IF(K2.LE«0) GO TO 420 

DO 410 L=lfNNPE 

Ll«MP<JfU 

L2=NPR(L1) 

1F(L2.ED,0) GO TO 410 
L:*«IABS{L2> 
IBCHK=IABS(K2-L2)+1 
IFtIBCHK.GT.IB) IB=IBCHK 
410 CONTINUE 
420 CONTINUE 
430 CONTINUE 


IF(IB.GT.IBMIO) IBMIO=IB 
LISTX=LSTCPX+LSTICX 
IFtLISTX.GT.NQMlO) N0MI0=1,1STX 

ESTIMATE STORAGE, REOIREHENTS FOR AN ADDITIONAL ELEMENT 

IFd.EO.NUHEU GO TO 4?9 

IBCHK=lB+(NNPE-3) 

NOCHK=LISTX+ ( NNPE-3 ) 

IF<IBCHK.LT.1BMI0.AND*N0CHK.LT.NQMI0) GO TO 900 

IF<NaCHK,LT.NOMI0) N0CHK=NaMI0 
IF<IBCHK,LT.IBMIO> IBCHK=IBMIO 

KCHK= (NOCHK-IBCHK) *IBCHK+ < < IBCHKi^Ka-lBCHK) /2 > +IBCHK 
IF<KCHK,LT.MAXV0L) GO TO 900 


499 CONTINUE 

PLACE ON TAPE AND PREPARE FOR NEW SEGMENT 

CALCULATE KUOL FOR CURRENT SEGMENT 

KU0L=(LISTX-IB)«IB+(<IB**2~IB)/2) +IB 
KMIO«=<NOHIO-IBMIO)#IBMIO+((IBMIO*»2-IBMIO)/2)+IBMIO 

NUMSEG ( 10) =NUHSEG { 10 ) +1 


FORMULATE LIST 

DO SIO J«J rLSTCPX 
LISTCJ)=LSTCP<J) 
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510 CONTINUE 

DO 515 J=lrLSTICX 
J1=LSTCPX4‘J 
LIST<J1)=LST1C< J> 
515 CONTINUE 

ICOHP-LSTCPX 


FORMULATE MOVE AND INTO ARRAYS 

DO 530 J-lfIDJ 
M0VE(J)^0 
INTP(J>=0 
530 CONTINUE 

M0VEX=0 


IF(NUMSEGaO) *LE,1> GO TO QOO 
JEND=LSTOLX 

IF( JEND*LTW-ISTK> JEND=^LISTX 

DO 650 J^ljJEND 
J1=J 

620 CONTINUE 

J2^=LST0LD(J1) 

J3-LIST(J1) 

IF(J2*NE*0> GO TO 6A0 
IF(J3*EQ*0) GO TO 650 

DO 630 K-I 7 JEND 
K1==K 

K2=LST0Lri(Kl) 

IFCK2«NE.J3> GO TO 630 

mouex5=mov;ex+i 
MOVE(MaVEX)=Kl 
INTD<M0VEX)=J1 
LST0LD(J1)«J3 
LST0LP<K1)=0 
IF(K1.GT*J) GO TO 650 
J1=K1 
GO TO 620 
630 CONTINUE 

IFCJl.UE^J) LST0LDCJ1)=:LISTCJ1) 
GO TO 650 
640 CONTINUE 

IF(J2*NF.J3> GO TO 650 
MOVEX-MDVEX+1 
MOVE(MOVEX)=J1 
INT0<M0VEX>=J1 
650 CONTINUE 


HAS MOVE BEEN SUCCESFUL 
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C 

ICHK=*0 

no 670 fJEHD 

IF(LSTOLn<J) .NE*LIST<J)> ICHK -+1 
670 CONTINUE 
C 

IF<ICHK.NE.O) GO TO 7003 


KHIO^(NQMIO-IBHIO)J»iISfiIO+(<IBHIO*iK2“IBMIO)/2)+IBMIO 


800 CONTINUE 


NSEG=:NUM8EGaO) 


IF<IC0MP*LT*1) GO TO 7001 
WRITE(6r8) NSEGfKVOL 

WRITE ( 6 f 2 ) NSEG f IB r LI STX r ICOMP f lELEX r MO VEX f I EMPT 
URITE(6r2> ( IELE< J) > J~1 » lELEX) 

WRITE(Af2) (LIBT(J)fJ=1fLISTX) 

WRITE<6»2) (NPR<J) tJ=*lFNUHNP> SUPRESSEB 

WRITE<6f 2) (MOVECJ)f J=lrMOVEX) 

WRITE<6r2> (1NT0 <J)fJ=1fM0VEX) 

IF(IO*ECl*l) WRITEd) 

1 NSEG FlJ&fLISTXrlCOMPrlELEXFMOVEXFlEMPTFlELEFNPRrLISTFMOVEF INTO 
IF(lO*Ea*2) URITE<3) 

1 NSEG F IB r L ISTX » ICQHP r I ELEX r MOVEX f IEMPT r IEL,E f NPR f LI ST f MOVE f INTO 
rF<LISTX*GT*IDJ> GO TO 7005 
IFaELEX^GT.IDI) GO TO 7005 


INITIALIZE FOR NEXT TAPE SEGMENT 
IF(I#EO,NUMEL) GO TO 900 


no 885 J=1 fIC0MP 
J1=^LIST< J) 
NPR(J1)='-1 
805 CONTINUE 

no 890 JelFinJ 
LSTOLD(J>^LIST<J) 
LIST<J)=0 
LSTCP( J>^0 
090 CONTINUE 
C 

no 891 j=ifim 

IELE(J)^0 
B91 CONTINUE 
C 

no 892 J-1 fIC0MP 
LSTOLIK J>=0 
892 CONTINUE 
C 
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IEMPT=^ICOMP 

lELEX^O 

LSTOLX-LISTX 

LISTX=0 

LSTCPX=^0 

IBOLD«IBHIO 


900 CONTINUE 


CALCULATION OF IDIAG 


IF<I0*E0.2) GO TO 930 
IDIAG<1U)=^1 
DO 920 I^OfNQHIO 
Il=NQMI0‘-I+2 

IF(I1*GT*1DMI0) I1=IBM10 
IDIAG a r I ) =IDI AG Cl F I-l > + Il 
920 CONTINUE 
GO TO 951 

930 CONTINUE 

151-2* (IBMlO-D-fl 
IDIAG(2 j1)=1 

DO 950 I^2fNGMI0 
U=IDT 

IFa»LT*IBMIO) Il=Il-(IBNlO-r) 

IFa*GT*NGM10-IB?1l0+2) Il=Il-aBMIO-(NQHIO-I >-2) 
IDlAD(2Fl)*=lDIAG<2Fl-l)fIl 

950 CONTINUE 

951 CONTINUE 


WRITE(<5f3> 

WRITE<6f4) KMIOfIBHIOfNOMIOfNUMSEG(IO) 

IFCKMIO^GT.HAXUOL) WRITECAfIA) KHIOfHAXOQL 

KHAX(IO)-KNIO 

IBMAXaO)=IBMIO 

NOMAX(IO>=NOMIO 

1000 CONTINUE 
REWIND 1 
REWIND 3 

WRITE(9)X0RDfYDRDfXBCf YBC rTBCFCXFCYfCHFTkFTYFTGFCOSXXPF 

1 NPBCfNPrXMINFXMAXfYMINFYMAXFNUMUPrNUMPpFNUHTPFNELMCTNELMTF 

2 NPPE F KMAX F IBM AX r NQHAX f NUMSEG f IDIAG f 

3 IDAFiBBfIDCFiDDFiDEFiDFFiDGf IDHFlDlFlDJfrDKtinUFnuiFlDNFlDOFlDP 
GO TO 7777 


ERROR MESSAGES 
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7001 URITE(6.5) NUMSEG 

miJE(6r6> (IELE<I)rI=^lrIELEX> 
WRITE(6f6) CLIST(I)rI=lrLISTX) 
STOP 


7003 WRITECi^rl) 

WRITE(6f 2) (LIST(i)Fl«=lrLlSTX) 
WRITE< 6 r 2 ) Cl STOLrUI) rI=lrLISTX) 

STOP 

7004 WRITE ( <5 f 13) 

WRITEC6rl4) (lORDERCIOtDfl^lrNUHEL) 
STOP 

7005 WRITE<6?7) IDIrlDJ 
STOP 


FORMAT STATEMENTS 

1 FORMAT C50H0 MOVE-INTO ROUTINE NOT VALID r LIST AND LSTDLH ARE > 

2 F0RMAT(20I5> 

3 FORMAT C40H0 KMAX IBMAX NOMAX NUMSEG > 

A F0RMAT(4I10) 

5 FORMAT C45H0 ERROR ™ FIRST NODAL POINT IN TAPE SEGMENT tl5r 
1 3AHIS NOT COMPLETED* lELE AND LIST ARE ) 

6 F0RMATC20I5) 

7 F0RMATC67H0 lELEX OR LISTX IS GREATER THAN DIMENSION IDI OR IDJ WH 
IICH EOUALf fI5f 4H ANDf 15) 

8 FORMAT(14HO TAPE SEGMENT rI4r 17H KVOL EQUALS rI6) 

9 FORMAT (39H0 NSEG IB LISTX ICOMP lELEX MPVEX lEMPT f/t 

1 40H lELECI) LISTCI) NPRCI) MOVECI) INTOCI) > 

10 FORMAT CIOHO IREAD ) 

11 FORMATCIOIS) 

12 FORMAT (12H0 lORDERCI) > 

13 FORMAT C34H0 ERROR IN lORDER ARRAYf lORDER IS > 

14 F0RMATC20I5) 

15 FORMAT (20H0 MAXVOL IBMIN ) 

U F0RMATC19H0 NOTEf KMAX EQUALS f IAi 28H WHICH EXCEEDS THE MAXVOL OF 
If 16) 

19 FORMAT C20H0 MSHCD(l) MSHCDC2) > 

20 FORMAT 

DATA FROM WAVE ) 

27 FORMAT < 

DATA FOR MESHt 13) 

7777 CONTINUE 
END 
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OVERLAYCFUaUj'ajO) 
PROGRAM COUPUE 


COMMON/Cl/ 

1 XORD<4tAA$)tYORD<^AA»>FXBC<$CC4)»YBC<*CC$),TBC{«AA$)i 

2 CX<$CCi) rCY($CC$),CH<^AA$) fTX(*CC*)rTY<4CCt)fTQ<*AA$>f 

3 COSXXPC$CC$) »NPBC(liAA») »NP<$FF« t$EE$) 

C0MM0N/C2/ 

1 XMIN r XMAX r YMIN i YM AX r NUH VP r N' >1PP r NUMTP r NELMC f NELMT f NPPE 
C0HM0N/C3/ 

1 lELE ( f 1 1 f ) f NPR ( !tBB$ ) ,LIST C $ J J* ) f HOVE ( ® J > f INTO ( $ J J« ) r 

2 IDIAG(2f$JJ*) 

C0MM0N/C4/ 

1 KMAX(2) fIt<MAX(2) rNQHAX(2) rNUMSEG(2>F 

2 NSEG , IB t LISTX f ICOMP f IELEX f HOVEX f IEMPT 

C0MM0N/C5/ 

i inAFlBBFlDCFlDDFlDEFlBFFlDGFlDHFlBlFlDjFlBKFlBLFlBMFlDNFlBUFlDP 
COMMON/C6/ 

1 SF<7f6f7) fWT<2f7>fNUHQPT(2)fISTRES(3) 

CDMF.DN/C7/ 

1 SKXX ( $L1. $ ) F SKXY < * LL4 ) F SKYX ( 4LL * ) f SKY Y ( »LL$ ) 

C0MH0N/C8/ 

I TIMEFBTIMEFDTMAXFnUMAXF 
1 BELUfBEUFfDELT.BELQf 
1 ITERGfITERT, 

1 BFCONVfDUCONVfDTCQNVfBGCONVf 
1 VECTLfCTEHPf 
1 THETA F ALPHA! F TRANS F 

X INCPR F INCPUf INCPL f IHTPR f JNTPU f INTPL f 
1 INCLCU<2) fINCLTU(2>fINTLCU(2) fINTLTU(2)f 
1 LCUfLTUf 

1 MNIfITHAXCfITHAXTf 
1 INCRfITVfMOPfINTEHPfLAGEUUfIRZ 

C0MM0N/C9/ 

1 UX{4CC$)f UY(SCC$)f UT<4CC$)f 

2 PX<$BD4) FpY<$DD*)fIPQ<*DD4F2>F 

3 FTXCJ;CC!t) FFTY(4CC!|i) fFTQ<$AA4>f 

4 SIGIIC$GGS)fSIGXX($GG$f3)fSIGYY<4GG4f3)fSIGXY(*GG$f3) f 

5 SIGTH<4GG4f3)fMAT(SFF$> 

DIMENSION 

1 RHSK4BB4)fRHS2<4BB4> 


REWIND 9 

READ < 9 > XORD f YURD f XBC f VBC f TBC f CX f C Y r CH f TX f T Y f TQ f COSXXP f 

1 NPBC fNP f XMIN f XMAX i YMIN f YMAX f NUMVP , NUMPP r NUMTP t NELMC f NELMT f 

2 NPPEf KMAX F IBMAX fNQHAX f NUMSEGf IDI AG f 
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3 IDArlDBrlDCf IBDTltiE^IDFf IDGflDHflDlTlDJrlDKTiriLiIDHf UiN^IDOflDP 
C 

NTPE-A 

NVPE=6 

C 

WRXTE<6r5> 

INPUT DATA AND INITIALIZATION 


READ HATERIAL DATA 
NUMNP>=NUMVP+NUMPP 
IF(NUMTP.GT.NUHNP) NUHNP^NUHTP 
NUMEL^NELHT 


WRITE<<5»11) 

READ(5»12) NUMAT 
WRlTE(Arl2)NUMAT 
DO 150 I^lrNUMEL 
MATtDal 
150 CONTINUE 

IF<NUMAT.EQ.1> GO TO 160 
WRITE(6»27> 

READ(5f 22) (iiAT(I)fI«l»NUMEL> 
WRI TE ( 6 F 22 )< H AT a ) F 1=1 r NUHEL > 
160 CONTINUE 


READ RUN DATA 
WRITE<6fl5) 

READ(5f 16> INCPftrINCPUf INCPL 
WRI TE C6 r 1 A ) INCPR r INCPU r INCPL 
C 

WRITE(6rl7) 

READC5flS) INTPRfINTFUfINTPL 
URI TE ( A f IS > INTPR i INTPU f INTPL 
C 

URITE(Af23) 

RE AD ( S F 24 > ITU F MOP F TRANS f THETA f INTEMP f LAGEUL f IR 2 
WRITE<AF24)ITVFM0PFTRANSFTHETAFlNTEMPrLAeEULFlRZ 
C 

WRITE<Af25) 

READ ( 5 F 26 > TIMEM r MNI f DUMAX f DTMAX 
WRI TE ( A F 2 A > TIMEM r NNI f DUMAX f DTMAX 
C 

WRITE<6f7> 

READ<5r4> ITMAXCf ITMAXT 
WRITECAf4> ITMAXCfITMAXT 

c 

WRITE<6f2) 

READ<5fi) UECTLrCTEMP 
WR I TE ( A F 1 > VEC TL f CTEMP 
C 

WRire(AF28) 

READ ( 5 F 29 ) I NTLCU < 1 > f I NTLCU ( 2 ) r INTLTU < 1 > r I NTLTU ( 2 ) t LCU f LTU 
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WRIlE(6f29)INTLCU(l) f INTLCU(2> t INTLTIH 1 ) » IKTLTU(2 ) ^LCUfLTU 


WRITE<6r30) 

READ ( 5 r 31 ) DFCDNV f DQCONVf DUCONV r DTCONV 
WR ITE < 6 f 31 ) DFCONV ? HDCDNV r DUCONV t DTCONV 


REWIND 1 
REWIND 2 
REWIND 3 
REWIND A 


PROGRAH INITIALIZATION 


CALL SHAFAC 
1 <NPPE> 

IF(NUMPPiEQ.O) GO TD 171 

DO 170 I^1,NUNPP 

PXtD-O.O 

PY(I)-0»0 

170 CONTINUE 

171 CONTINUE 

DELU=0.0 

DELF“0*0 

DELT=0*0 

DEL0=^0.0 

INCLTU(l)^INTLTUCl) 

INCLCUa)=INTLCU<l> 

DO 175 I=ltNELHC 
DO 175 J=1 t 3 
SIGXXdr JJ-O.O 
SIGYYCIt J)=0,0 
SIGXYCIf J)-0*0 
GIGTH(IyJ>=0,0 
175 CONTINUE 


DO ISO I^ItNUMNP 
UXCI)“0.0 
UY(I)=0.0 
UTCI)=0*0 
ISO CONTINUE 


WRITE(6t3) 

READ<5f4> Nl TStNSEC 
WRITE (6f 4 >NPTS^ NSEC 

IF<NPT5*EQ»0) GO TD 183 
URITE(6r3A) 

DO 1B2 I=lrNPTS 
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REAn<5^35> HfXORri<n>rYORD<ii)rUX<n)»UY<n) fUT(ii) 
MRITE(6r35>IltX0RDCIl) rYORBaDfUXaDfUYdl) rUT(ll) 

182 CONTINUE 

183 CONTINUE 
C 

IF(NSEC*EQ*0> GO TO 186 
WRITE<6f8) 

DO 185 lelfNSEC 

READ ( 5 f 9 > JBGN f JEND y INCR ^ TEMPO f UXO» UYO 
UR I TE ( 6 f 9 > JBGN r JENO f INCR f TEMPO r UXO f U Y 0 
C 

DO 185 J==JBGNfJENDfINCR 
UT<J)=TEMPO 
UX< J)=UXO 
UY(J>^UYO 
IBS CONTINUE 
C 

186 CONTINUE 
C 

CALL BNDRY 
C 

190 CONTINUE 


WRITE(6f6) 

TIME^OfO 

INCR=0 

DTIME=^DTMAX 


200 CONTINUE 


BEGIN NEW INCREMENT 


IF(ITU.GT*0> CALL CREEP 

1 (XORDrYORDFXBCFYBCFTBCFCXFCYFCHfTXFTYFTQrCOSXXPFNPBCfNPf 

2 lELEFNPRFLISTrMOVEFlNTOrlDIAGr 

3 SKXXfSKXYfSKYXrSKYYr 

A UXFUYfUTFpXFpYFlPQFFTXrFTYFFTQFSIGIIfSIGXXfSIGYYFSIGXYfSIGTHF 

5 RHSlFRHS2fMATF 

6 IBAFiriBFlBCFlDDFiriEflDFFlDGdnHFlDIrlDJFiriKFlDLflDMrlDNflDOFlDP) 
IF<ITU,GT.O) ITU*=ITV*MOP 

C 

IF(ITUiLT*0) CALL TEMP 

1 <XaRDFYORDFXBCFyBCfTBCrCXfCYpCHFTXFTYFTQfCQSXXPfNPBC»NP» 

2 lELEFNPRrLISTrMOUEFlNTOflBIAGF 

3 SKXXfSNXYfSKYXfSKYYF 

A UXFUYFUTpPXFPYflPflrFTXrFTYfFTGFSIGIlFSIGXXFSIGYYFSIGXYFSIBTHf 

5 RHSlFRHS2FHATf 

6 IDAFiDBFiDCFiDDf IDEFlDFFlDGFlDHFlDlFlDJFlDKFlBLrlDMrlDNFlDOflDP) 
IFaTU*LT*0) ITV=ITO*MOP 

C 


IF<INTEMPfNE*1) go TO 350 

INTEMP^O 

WRITE(6f33) 
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mxrE(6fX) (UT(I>fI=lrNUMTP> 

GO TO 200 
350 CONTINUE 
C 

INCR=tNCR*fl 

LCU^O 

LTU==0 

IP<INCLCU(1> .GT*INCR> GO TO 370 
LCU^l 

INCLCU< X >==INCLCU ( 1 ) +INTLCU C 1 ) 

370 CONTINUE 
C 

IF(INCLTU(l)tGT*INCR> GO TO 375 
LTU-1 

INCLTU<1)“INCLTU(1>+INTLTU(1> 

375 CONTINUE 

IF<TRANS,EQ.l) GO TO 420 
IF<nELT*LE*DTCGNU> MNI^^INCR 
GO TO 450 
420 CONTINUE 

TIHE=TIME+DTIME 
IFCTIME.GE.TIMEH> HNI=INCR 
IF<LASEi tfEQ.O) UO TO 450 
DO 440 I-lfNUMNP 
YORD ( I >=YORD ( I ) TUY ( I ) :*fDTIME 
IF(IRZ*EQ*l*AND*XORD<I>.EQtO.O) GO TO 440 
XORD (I ) =XORD (I ) +UX ( I > JKDTIliE 
440 CONTINUE 
450 CONTINUE 
C 

IFdNCR.LTtMNI) GO TO 460 
C 

INCPUj=:INCR 
INCPL«INCR 
INCPR=INCR 
460 CONTINUE 
C 

CALL PPP 

X <X0ftDTY0R»fXBC7YBCrTBCFCXfCYTCHrTXfTYfTQfCQSXXPTNPBCtNPT 

2 UXfUYtUTfPXfPYf IPO yFTXrFTYfFTOf SIGH FSIGXX*SIGYY»SIGXYFSIGTHfHATf 

3 IDAflDDfIDCririDrIDErIBF»IDGFlDHFlDIf IDJririKFlDLFlDHFlDNrlDOFlDP) 

C 

IFaNCR.GE^NNI) STOP 
C 

IF (TRANS* Ed tO) GO TO 200 
C 
C 

C CALCULATE NEXT DTINE 

C 

DTIME^DTMAX 
GO TO 200 
C 

c 

c 

c 

C FORMAT STATEMENTS 

C 

1 F0RMAT<10E10*3> 

2 FORMAT (20HO UECTL CTEHP ) 

3 Ft3RMAT(20H0 NPTS NSEC > 
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A F0RMAT<8110> 

5 FORMAT 

l)|c;KJ»JJ|(J#c*;K#)|c3K*3»t5J:***3K*5K**3*c***#)|c«*3K*3*t)|t**3|(*J|t DATA FROM COUPLE ) 

OUTPUT DATA ) 

7 FORMAT <20H0 ITMAXC ITHAXT ) 

S FORMAT (AOHO JBGN JEND INCR TEMPO UXO 

1 UYO ) 

9 F0RHAT<3I10r3E10*3> 


11 

FORMAT <1 OHO 

NUHAT) 





12 

FORMAT < 110) 






14 

F0RMAT(4E10.3> 






15 

FORMATOOHO 

INCPR 

INCPU 

INCPL ) 



16 

FORMATOIIO) 






17 

FORMAT (30H0 

INTPR 

INTPU 

INTPL) 



18 

F0RMAT<3I10> 






22 

F0RHAT(20I4) 






23 

F0RMAT<70H0 

ITV 

MOP 

TRANS 

THETA INTEMP 

LA 

IGUEL IRZ 

> 





24 

FORHAT(2I10r2FlO *3^3110; 





25 

F0RMAT<40H0 

TIMEM 

MNI 

0UMAX 

DTMAX > 



26 FORMAT<E10*3»I10r2E10*3) 

27 FORMAT (12H0 MAT ARRAY ) 

28 FORMAT(60HOIMTLCUC1) INTLCU<2> INTLTU(l) INTLTU(2) LCU 

1 LTU > 

29 FORMAT(7I10> 

30 FORMAT (40H0 DFCONV DQCONV DUCDNV DTCONV ) 

31 F0RMAT<7E10*3> 

33 FORMAT <24H0 INITIALIZED TEMPERATURES > 

35 F0RMATa572E10*3f3E18*10) 

Z6 F0RMAT(20H0 INITIALIZED VALUES r/f 79H NP XORD YGRD 

i UX UY UT ) 

C 

C 

END 
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i)LIJBROUTINEr CRKEP 

1 <XOriDrYORDFXBCfYErCfTBC#CXfCYTCHfTXfTYrTQfC:OSXXP»NPBCrNPF 

2 IELE/NPRrLISTrMOVE»rNTOrIErIAGf 

3 SKXX,SKXV#SKYXrSKYYr 

A UXrUY»UTrPXrPYFlPQ#FTX»FTYiFTQTSIGII#SIGXXfSIGYY»SIGXYfSIGTHf 

5 FXfFYrMATt 

6 iPAylDBtmCflDDrlDErlDFrlDGf lUHflDI^IDJflOKrlDLflDMrlDNrlDOflDP) 


DIMENSION 

1 XORD<IDA)fYORD<IDA>»XBCaDC)rYBC(IDC)FTBC(IDA)» 

2 CX<IDC)fCY(IDC)^CH(irpA) r TX< IDO rTY<IDC) fTQ(IDA) r 

3 COSXXPCIDO fNPBC(IDA) f NPCIDFrlDE) 

C0MM0N/C2/ 

1 XMIN r XM AX r YHI N t YMAX f NUMVP r NUMPP f NUHTP f NELMC f NELMT » NPPE 
DIMENSION 

1 IELE(IDI)»NPRaD3>fLIST<IDJ)rHOVE(IDJ)rINTO(irjU>»UaAG(2yirU) 
C0MM0N/C4/ 

1 KHAX<2> f IBMAX<2) rNQMAX(2> fNUMSEG<2> / 

2 NSEG r IB r LISTX t ICOMP f lEUEX » MOMEX lEHPT 

C0MM0N/C6/ 

1 SF<7T<Sf7?TUT(2T7>»NUMQPT<2>rISTRES<3> 

DIMENSION 

1 SKXX < I DL) » SKX Y < I DL > r SK YX < I DL. > f SK Y Y (I DL ) 

COMMQN/CS/ 

1 riMEjDTIME7DTHAXTDUMAX? 

1 DELUfDELFFDELTfDELQf 
1 ITERCrITERTr 

I DFCONVFDUCONVrPTCONVrDOCONVr 
1 VECTtfCTEMPr 
1 THETA fALPHAT 7 TRANS f 

1 I NCPR 7 INCPU f INCPL r INTPR f INTPU f INTPL f 
1 INCLCU(2) » INCLTU(2) r INTLCU<2> fINTLTU(2 ) i 
1 LCUfLTUx 

1 HNIfITMAXCfITMAXTf 
1 INCR7lTV7HOp7lNTEMPrLAGEULfIR2 

DIMENSION 

1 UXanC)FUY<IDC)FUT(IDA)7 

2 PX(IDD>FPy<IDD)f IPCKIDD72 )f 

3 FTX<IDC)7FTYaDC)7FTQ<lDA)r 

4 SIGII(IDG)rSIGXXaDGr3)fSiaYy<IDG73>rSIGXY(lDG73)7SlGTH(IDGf3)i 

5 KAT(IDF) 


DIMENSION 
1 FX(ID&>fFY(lDD) 

COMMON 

1 TXXC9r9>rTXY(979>rTYX<9f9>7TYY<?F9)f 
1 SXX(9r9>tSXY<?79) rSYX(9»9) 7SYY(9r9) r 
1 SPX<6t3)7SPY(673) F 
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1 S1GXXJC3) f SIGYYJ<3> fSIGXYJ<3) rSIGTHJO) i 
1 DMQDX(3)fnNarJY(3>f 

1 RJAC(2f2)rRJACI(2f2) f DNDX(6) #DNDY<6) 

C 

c 

NWE«6 

NTPE-6 

NUHNP«N(Jf1MP+NUHPP 

NNPE=NVPE-fNPPE 

INCLCU(2)=rI^^rLCU(2) 

ITEPC«0 

C 

C 

LSTPl*=^NQHAXa>+i 
IDI AG < 1 f LSTPl ) ®KMAX (1 > -f 1 
100 CONTINUE 
C 

IF<LCU.EQ»1> SKBC-l*0E+20 
C 

c 

DO 140 l=lfNUMVP 
FX<I)«0*0 
FYCI)«0.0 
FTXU>aC*0 
FTY<I)‘=0»0 
140 CONTINUE 
C 

IF(NUHPP*EQ*0) GO TO 146 
C 

DO 145 I«lfNUMPP 

Il^NUWPfl 

FX<Il)-0*0 

FY<I1)«0*0 

Ipa<Irl>-0 

IpCHIr2>=0 

FTXCID^O.O 

FTY(I1)=0*0 

145 CONTINUE 
C 

146 CONTINUE 
C 

c 

c 

c 

c 

IF(LCU*EQ*a> 60 TO 161 
1EWD=KMAX(1) 

DO 160 I«lfIEND 

SKXX<I)“O*0 

SKXY<I>«0.0 

SKYX(IJ=0*0 

SKYY(I)=0#0 

160 continue 

161 CONTINUE 
C 

C 

REWIND 1 
REWIND 2 
C 
C 
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FUKMATiaN AND DIAQ0NALI2ATI0N OF K MATRIX 


lEND^NUMSEG(l) 
00 A99 I=1fIEND 


READ<1) 

1 NSEG ^IBrLISTXrlCOMPflELEXfMOVEXFlEMPTFlELErNPRf LIST *H0VEf INTO 
IF(LCU,E0.0) REAIX2) SKXX r SKXY r SKYXr SKYT f SKBC 

IF<I*NE.NSEO> GO TO 7007 

IF<I*GTa*ANO.LCU*EQ*l) CALL SLIDE 

1 < lELE 1 NPR f LIST » MOVE r INTO f IDI AG r BKXX f SKXY r SK YX » SK YY f 

2 IDAfIDBpIDC»IDD»IDEFlDFpIDGrIDHfIDlFlDJ/IDKFiriLFlDMf IDN fIDOfIDP) 


DO 370 J*1fIELEX 

TELEJ==IELE<J> 

MJ==MAT(IELEJ) 


DO 210 K“lfNNPE 

DO 210 L^lrNNPE 

SXX(KfL)=0*0 

SXY(K#L)=0.0 

SYX<KfL>=OtO 

SYY(KfL>“0.0 

TXX(KfL)=0.0 
TXY(KrL)=0*0 
tyX(KfL)==040 
TYY(KfL)==0*0 
210 CONTINUE 

DO 212 K=lr6 
no 212 L=1 f3 
SPX<KrL)=0,0 
SPYCKfL>-0*0 
212 CONTINUE 

VOL^OtO 

BEGIN QUADRATURE 

KEND=NUHaPT<l> 

DO 2<60 K«=lrKEND 

KPEH^K 

DO 213 L=1f3 

215 IF(I5TRES<L) *EQ.K> KPEN*=^K 


XK“0;0 

YK”0,0 

TEMPK=0,0 

UXK^OtO 
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UYK=0*0 

RJAC(1.1)=0.0 

RJAC<1#2>=0*0 

r<JACC 2 rl>^ 0.0 

RJAC(2r2)==0*0 

C 

DO 220 L«i>A 
C 

Ll^NP<IELEJfL> 

XK=XK+SF < 1 f L I K > *X 0 RD < NP (I ELE J r U ) > 

YK=^y K+SF ( 1 f U r K > *Y0RD < NP < lELE J » L > > 
TEMPK^TEMPKFSF afLrK)JicUT(Ll) 

UXK«UXK+SF C 1 r L » K ) 3KUX ( NP ( lELE J r U ) 

U YK=rJ YK+SF < 1 F L f K > *U Y ( NP < I ELE J f L ) ) 

C 

RJ AC < 1 f 1 ) =RJAC (1 F 1 > +SF ( 2 f L F K ) *XORD ( NP (lELEJ F L> ) 
RJACaF2>^RJACClF2)+BF(3FLFK)5|tX0RD(NP(IELEJFU ) 
RJAC(2f1>«RJAC(2f1)+SF<2fLfK)*Y0RD<NP(IELEJfU ) 
RJAC(2f2)»RJAC<2f2>+SF<3fLfK>*Y0RD(NP(IELEJfL)) 

c 

220 CONTINUE 
C 

PET J=R JAC < 1 F 1 ) *R JAC C 2 F 2 ) -R JAC ( 2 f 1) *R JAC ( 1 f 2 ) 

C 

IF<DETJ*LT*0> GO TO 7002 
C 

R JACI ( 1 F 1 ) =+R JAC < 2 y 2 > /BET J 
R JAC I< 1 F 2 ) --R JAC ( 1 F 2 > /BET J 
R J AC I ( 2 r 1) JAC < 2 f 1 ) /DET J 
RJACI ( 2 F 2 ) "FR JAC ( 1 f 1 > /DET J 


DV=DETJ 

IF<IRZ»EQ*1> W==XK*DETJ 


DO 235 L^if6 

DNDX(L)^RJACK1f1>H(SF(2fLfK)+RJACI(2f1)*SF<3fLfK> 

DNDY(L>=RJACI(1f2)#SF{2fLfK)+RJACX<2f2)3|cSF<3fLfK) 

235 CONTINUE 

DO 236 L«1f3 

L1=L 

L2==L+3 

DNQDX(U=RJACI<1f1>*SF<7fL1f1>+RJACI(2f1)*SFC7fL2f1> 

DN0nY(t)=RJACI(lF2J3#cSF(7fLlFl)+RJACI<2F2):trSF<7fL2Fl) 

236 CONTINUE 


CALCULATION OF PLASTIC STRAINS f STRESSES AND ELASTIC FORCES 


CALCULATE TOTAL STRAIN RATE AND VORTICITY 
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EF'bXX - 0 * 0 
EPSYY=0.0 
EPSTH=0.0 
EPSXY=0.0 
0MGYX=0.0 
C 

DO 2^0 L=1/NVPE 
Ll=NP(IELEJrL) 

EPSXX=EPSXX+DNDX <L) *UX <L1 ) 

EPEY Y=EPS YY+DNDY < L ) JiOJY < LI ) 

EPSXY-EPSXY+ CriNDX<L>*UY<Ll) +DNDY < L > WX ( LI ) > /2 . 0 
OHGYX=OMGYX+<DNDY<L)JKUX<L1)-DNDXCL>*UY(L1>>/2#0 

240 COMTINUE 

IF < IRZ . EQ * 1 • AND . XK» EO * 0 1 0 ) EPBTH=EPSXX 
IF < IRZ * EQ . 1 . ANtu XK « NE . 0 • 0 ) EPSTH=UXK/XK 
artQXY=-OMGYX 

c 

GK^G(TEMPKfMI) 

IFCGK.LTtOtO) GO TO 242 
C 

c CALCULATE STRESS RATES 
C 

DXXDT-0*0 

DYYDT=0*0 

DXYDT=0*0 

DTHDT=0*0 

C 

DO 241 L==lf3 

DXXDT“DXXDT+DNQDX ( L > Jt^S I BXX < I ELE J f L ) *LIXK 
1 -f DKQDY < L ) *SIGXX < lELEJ r L ) #UYK 

1 -2 . O^SIGXY ( lELEJ r L ) 

DYYDT=DY YDT+DNQDX ( L > $SIGYY < lELE J f L ) *UXK 
1 +DNCDY C L > jKSIGYY ( lELE J r L ) *U YK 

1 -2 1 OJUSIGXY ( lELE J f L ) *OMGX Y 

DXYDT=DXYDT+DNGDX < L ) 5KSIGXY ( lELE J y L > IKUXK 
1 +DNQDY ( L ) ♦SIGX Y ( lELEJ r L ) *UYK 

1 “SIGXX < lELEJ p L ) JHOMGXY-SI GYY< lELEJ r L ) 5H0MGYX 

JF<IRZ.EQ*0) GO TO 241 

DTHDT-DTHDT+DNODX< L > JifSIGTH C lELEJ r L )#UXK 
1 +DNQDY < L > *SIGTH ( lELE J f L > *UYK 

241 CONTINUE 
C 

C 

C CALCULATE PLASTIC STRAIN RATES 

C 

C 

EPSXX=EPSXX-DXXDT/ { 2 * 0*GK > 

EPS YY-EPS YY-DY YDT/ ( 2 . 0#GK ) 

EPSXY=EPSXY-DX YDT/ ( 2 * 0#GK ) 

EPSTH^EPSTH^DTHDT/ < 2 . 0*BK ) 

C 

242 CONTINUE 
C 

C CALCULATE EPSII 

C 

EPS.T 1= ( 2 ♦ 0/3 4 0 > }»t < EPSXX}|c*2+EPSYy##2'fEPSTH3|t*2-f2 ♦ OJkEPSX Y:<t*2 ) 
EPSII=SQRT<EPSII> 

C 

CALL U I S C ( VS f UT F PENLT Y f NPPE f EPS 1 1 1 TEMPK # XK f YK f M J ) 

C 
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IF<K.Ea.l) SIGII(IELEJ)=3,0*gs*EpSII 


CALCULATE STRESS DEUIATOR 


DO 243 L=l,3 

IF<ISTRES<L).NE.K> GO TO 243 
SIGXX J ( L > =2 . 0*V> ■*EPSXX 
SIG YY J < U =2 . OV-.VSHeEPS YY 
SIGXYJ (L) =2 . 0*yS#EPSXY 
IF<IRZ.EB.O> 60 TO 243 
SI GTH J ( L ) =2 . 0*VS*EPSTH 
243 CONTINUE 

IF(DV.EO.O.O) GO TO 260 


CALCULATE DODY FORCES AND ELASTIC FORCES 

GAMXK=GAHX ( TENPK r XK f YK r M J ) 

GAM YK=G AM Y < TEHPK » XK f YK » M J ) 

IF<GK.GT.OiO> StCLAX^US/GK 

UTDV=UTa»K>*DV 
DO 24G L=irNUPE 

L1~NP(IELEJ»U 

FXLl =SF ■! 1 j L » K )#GAMXK:|<UTDM 
FYLl=>Sr- Cl»LrK»lfGAMYK#UTDV 

IF(GK.LT,0.0> GO TO 246 

FXL1="XL1+RELAX» < DNDX (L) *riXXDTFDNDY< L) *DXYDT ) *WTDV 
FYLX=^FYL1+RELAX* (DNDY < L ) *DYYDT+DNDX <L )^BXYB7 ) *WTDV 
IFdRZ.EQ.O) GO TO 246 

FXLl =FXLi+RELAX*SF( 1 f L » K ) ltDTHDT* < 1 1 0/XK > «WTDV 

246 CONTINUE 

IF(C0SXXP<L1) .EQ.1.0) GO TO 247 
C=C0SXXP<L1) 

5=SQRT<1 ,0-C#!)c2) 

FXP==FC*FXL1+S*FYL1 

FYP=-S*FXL1+C*FYL1 

FXL1=FXP 

FYL1=FYP 

247 CONTINUE 
FX(L1)=FX(L1>+FXL1 
FY<L1)=FY(L1)+FYH 
FTX(L1)=FTX<L1)-FXL1 
FTY<L1)=FTY(L1>-FYL1 

24B CONTINUE 


rsT=i 

V=VS 

V2='2.03|cUS 
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ir<K*EQ.KPEN) V2=2«0*VS+PENLTY 
P*=PENLTY 
C 

250 continue 
C 

DO 257 L.=lrNVPE 
DO 255 M^lfNVPE 
C 

XX^ ( DNDX < L ) # V2*DNDX ( M ) +DND Y ( L ) #U)HDNDY t M ) > * WTD V 
YY=J < DND Y ( L ) iK V2tDNDY ( M > +DNDX ( L ) * V»dNDX < H > > tUT DV 
X Y= ( DNDY ( L ) V*DNDX < M ) > JkWTDO 
C 

IFdRZtEQ.l) 

1 XX-XX+SF ilfLrt\)$( V2/ < KKt^Z ) ) *SF < 1 r M f K ) W TD V 
C 

IF<IST.EQ*2> GO TO 252 
SXX<r »H)=^SXX<l-fM)+XX 
SYYiLrM)«SYY<LrM)+YY 
SXY(L»H>=SXY<LfM)fXY 
IF(LCU,£Q.O*OR*VT.NE*VS> GO TO 253 

252 CONTINUE 
TXX<LrN)=TXX<L»M>+XX 
TYY<LfH>=TYY<LrH)+YY 
TXY(L>M)=TXY(LfM)fXY 

253 CONTINUE 
C 

IFaST*EQ*2) GO TO 257 
IF<NPPE*NE*D.0R,K*NE4KPEN) GO TO 255 
XY==DNBX < L > tPJKDNDY ( M ) JKWTD V 
IF(IR2»EQ,0) GO TO 254 
C 

XX^<riNDXCD*(P/XK))tcSF(lTMrK>-fSF{lfLfK>:*c<P/XK)*rtNDX(N))JkWTDV 

XY==X Y+SF a f L F K ) iK C P/XK ) *DNnY < H > tMTW 

SXX<LfM)«SXX<LtN)4‘XX 

254 CONTINUE 
SXY<LrN)=SXY<LrM>+XY 
IF(LCU*EG*0) 60 TO 255 
TXY(l-fM)*TXY(LrM>l-XY 
IF(IR2*EQ*0) GO TO 255 
TXX<LrM)=TXXCL7M)+XX 

C 

255 CONTINUE 
C 

IF(NPPE*Ea.O> GO TO 257 
DO 256 M-1 fNPPE 

GPXCLfN)=SPX(t7M>FSF<4rMFK)#DNDX(L)*WTDV 

SPY<LrM>=SPY(ErH)TGF(4TM7K>5KDNDY(L)WTDU 

IF<IRZ.EQ*1> 

1 SPX(LfN)=SPX(LrM) + <5F<4fMFK>)fiSFdrLrK)/XK))lcWTDV 

256 CONTINUE 
C 

257 CONTINUE 
C 

lF<I6TfEa*2> GO TO 258 
IF(UT*EQ*VS> GO TO 258 
IST«=2 
V=UT 

V2=2.0JffVT 

IF<K*EQ*KPEW> V2=2.0*VT+PENLTY 
GO TO 250 
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c 

258 CONTINUE 


VOL=VOL+WTDU 


260 CONTINUE 


no 265 K=lr3 

SIGXX(IELEJfK)=SI6XXJ(K> 

SIGVY(IELEJfK)=*SIGYYJ(K) 

SIGXY(XELEJ?K)=SIGXYJ(K) 

IPaRZ.EO»l> 

lSIGTHaELEJrK)=SIGTHJCK> 
265 CONTINUE 


END OP VOLUME QUADRATURE 
BEGIN SURFACE QUADRATURE 


DO 290 K=lf3 
K1^2JHK 

MIDSIB=NP(IELEJrKl> 

SUM=TX<MlDSID>+TY<MinSID)+CX<HinslD>+CY«MIBSID> 
IF(SUM*EQ*0*0> GO TO 290 
NBC=rABS(NPBC(MinSID) > 

267 IF(NBC.LTaO) GO TO 268 
NBC=NBC-10 

GO TO 267 

268 CONTINUE 


LEND=NUMRPT(2) 
no 280 L=1»LEND 

XL=0*0 

rtxnxi=o*o 

nYDXI=0*0 

TXL-O.O 

TYL^O.O 

VXL=0*0 

VYL=0,0 

CXXL«=0*0 

CXYL^O.O 

CYYL*=0*0 


m=KI“2 
DO 270 H=lr3 

IF(M1*EQ*7) Ml==l 
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NPM-NP(IELEJfMl) 

C 

SFArtL«SF(AfMjL> 

SF5MLJ=^SF(5rMfL) 

C 

nXriXI^DXDXI+SFAMLsicXORD ( NPH > 
IiYriXI=Dyi:iXI+SFAML*YQRO(NPM) 

C 

XL=XL+SFSHU5kX0Rn ( NPN ) 

c 

C=COSXXP(NPM) 

S=SCJRTa*0-C*}ft2) 

c 

TXL=TXL+SF5ML» < C*TX ( NPH > -BtTY t NPM > ) 

TYL=TYL+SF5HUJJ« < SJtcTX <NPM ) +C*TY ( NPM ) > 

VXL“UXL+SF5ML*<C*CXCNPM)3|£XBC<NPf1>'-S3*JCY(NPH)*YBC(NPM) ) 
VYL=VYL+SF5ML5K(S3/iCX(NPM>;*(XBC(NPH)+CJ»£CY<NPM))»:yiiC<NPM> ) 
CXXL^CXXL+SF5ML# < C*CX ( NPM ) JKC+BJlfC Y < NPii > Jl^S ) 

CX YL=CXYL+SF5MU <C :X ( NPM ) HiS- S*C Y < NPM > ) 

CYYL=CY YL+SF5MLJj( C :X < NPM > >lcS-fC3KC Y ( NPM J *C ) 

C 

270 CONTINUE 

TXL=TXL+VXL 

TYL=TYL+VYL 


rtS=SORT C DXDXX3|fit:2+DYJJXI}|{}t£2 ) 

IF<IRZ.Ea.l) DS=XL*DS 

Ml==Kl-2 
BP 2B0 M=lf3 

IFCM1*EQ*7) Ml=l 
NPMl'^'NpClELEJyMl) 

WTSFM=WT(2yL):*CSF(5fMfL> 

C=C0SXXP(NPM1> 

S=S0RT<1*0-C3K*2) 

FX ( NPM 1 ) “FX < NPMl ) +WTSFMJ*? < +C*TXL*f S;|(T YL ) tBS 
FY ( NPMl ) =FY < NPHl ) f WTSFM* ( -S)jcTXL+CJ|cTYL ) *BS - 

TXMl=CXXUlcUX < NPMl ) + CXYLXiUY C NPMl ) 

TYMl =CX YL*UX ( NPMl ) +C YYLJi^UY ( NPMl ) 
FTX<NPM1>^FTX<NPM1)^WTSFM3|£(+C#TXM1+S*TY«1)#DS 
FTY < NPMl ) =FTY ( NPMl ) -WTSFMjIJ < -SjKTXM l+C>»cTYMl ) JjcDS 


N1«K1“2 
DO 280 N=lr3 
C 

N1=5N1+1 

IF(NliE0.7> Ni^l 
C 

SFNDS^SF(SfNrL):ffDS 

C 

SXX(MlfNl)=BXX<Ml^Nl>+UTSFH:*JCXXL3ifSFNBS 
SX Y ( Ml » N1 > =SXY < Ml , N1 > +WTSFM:*cCXYL*SFNriS 
S YY ( Ml r N1 > =SYY ( Ml t N1 > +UTSFM*CYYL#SFNDS 
IFCLCU.EQ*0) GO TQ 280 
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TXX ( Ml r N1 > =TXX ( Ml r N1 ) +WTSFM*CXXL*SFNIiS 
TXY(M 1 rNl >=TXY<Mlf Ml J+WTSFH*CXYLJKSFNtrS 
TYY ( Ml f N1 ) =TY Y < Ml r N1 > +WTSFM#CYYL*SFNIiS 

280 CONTINUE 
290 CONTINUE 

END OF SURFACE QUADRATURE 
END OF QUADRATURE 


IF<V?QL.LT,0*0) 60 TO 7001 


DO ZX6 K=1f6 
no 316 U-lf6 
SYX(LrK)=5XY(KrL) 
TYX(L#K)«TXY(KfL> 

316 CONTINUE 

rF<NPPE»EQ^O) GO TO 340 


DO 330 K==lfNPPE 
lP=NP<IELEJrK+6) 

IP=IP-NUMVP 

IFaPGKIPf 1) *EQ*0) 60 TO 324 
IPQ(IPf2)=IELEJ 


DO 322 L=lr6 
SXX(Ki6^L)=0*0 
SXY(K+6rL)=0*0 
SyX<K+6fL>«SPX<LfK> 
SYY(K+6rL>«SPYCUfK) 
322 CONTINUE 

SXX<K+6rKl-6>=0»0 

SYY<K4-6fK4-6)==-l*0 

60 TO 328 

324 CONTINUE 

rPQ<IPrl>=IELEJ 

no 326 L=lf6 
SXX(Kf6»L)=SPX(LrK) 
SXY<KF6rL)-SPY<LrK) 
syY(K+6»L)=0*0 
SYX(K+6rL>^0*0 
326 CONTINUE 


SXX<K-16rK+6)=0*0 
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SYY(K-f6fK+6)=l*0 
32B CDMTINUE 


DO 329 L^lr6 
S Y Y ( L ^ K+A ) ==SYY < K+4 - L) 
SYX(LfK+ 6 )=SXY<K+AFU 
5XXCLfK-f6)=SXXCK'f6»L) 

SX Y < L f K+6 ) ==SYX < K+6 r L) 

329 CONTINUE 

330 CONTINUE 

DO 335 K=1»NNPE 
DO 335 L^lrNNPE 

IF<K»LT*7>AND4L»LT*7) GO TO 335 

TXX<KrL)=SXX(KrL> 

TXY(K*L>=:SXy(KfL) 

TYX<KrL)“SYXCKrU 

TYYCKfL>=SYY<K^U) 

335 CONTINUE 
340 CONTINUE 


ROTATION OF BOUNDARY POINTS 

DO 348 K==lyNUPE 
C=CDSXXP(NP(IELEJfK) > 
IFCC»EQ.1*0) GO TO 348 
5 ^SQRTa* 0 -C* 5 K 2 > 


c 


c 


c 


c 


c 


c 


c 


DO 346 L=l7NNPE 

XX=+C;*cSXX(KfL}+S)kSYX<KTL) 
X Y-+OKSX Y < K r L ) +S)»(S Y Y ( K f L > 
YX=“S5HSXX ( K f L) +cj#«s VX < K y l> 
Y Y=^-S*SX Y < K f L > +C*S Y Y < K r U 

SXX(KfU=XX 

SXY(K»U)°XY 

SYX(KfL>==YX 

BYY<KrL)“YY 

XX=-hSXX < L 5 K > 3*cC+SX Y ( L y K ) JKS 
XY=-SXX < L y N ) J»iS+SX Y < L f K ) *C 
vx=+SYX (LfK) 3 KC*fS Y Y ( L y K ) 3 <cS 
YY=“S YX ( L y K ) ^S+S Y Y (LfK>tC 

SXX(LrK)=XX 

SXY<LyK>=XY 

SYX(LrK)^YX 

SYY(L.yK)=YY 

IF(LCU.EQ*0) GO TO 346 

XX-+C*TXX < K y I- ) +S*TYX <: K y U 
XY=s-f Ci»5TX Y < K f L ) FSJjcT Y Y ( K r L > 
YX=-S#TXX ( K f L) *J-C3HT YX ( K f L ) 
YY=-SJftTXY<KyL>+C#TYY<KyL> 
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TXX(KrL)==XX 

TXY(K7L>=XY 

TYX(KfL)«YX 

TYY(K»L)«YY 

C 

XX=+TXX(LrK>#C+TXY(LrK)*S 
XY^-TXX ( L r K ) *S+TX Y ( L r K ) JjrC 
YX=+TYXCLfK)#CmY(LrK)JKS 
YY=="*T YX ( L T K ) *S+TY Y ( L f K ) 3*cC 
C 

TXX<LrK)^XX 

TXY(LrK>=XY 

TYX(l-fK)=YX 

TYY(LfK)=YY 

C 

CONTINUE 

C 

546 CONTINUE 
349 CONTINUE 


CALL STIFFdELEJrlTV) 


SUBTRACT 3KW FROH RHS 

DO 359 K=1»NNFE 
NPK^NPCIELEJtK) 

IF(K.DT*NUPE) 60 TO 354 
UXK-UX<NPK> 

UYK=UY(NPK) 

C»COSXXP<NPK> 

IF<C.EQ*1*0) GO TO 350 
5=SQRT<1<0-C#*2) 

UXKsf Ci*cUX ( NPK ) +S:KUY < NPK ) 

U YK^-S5KUX ( NPK ) +C#UY ( NPK > 

350 CONTINUE 
C 

NBC= I ABS t NPBC ( NPK > ) 

C 

351 IF(NBC*LT.10) GO TO 352 
NBC=NBC-10 

GO TO 351 

352 CONTINUE 
C 

I F ( NBC * EQ . 4 . OR ♦ NBC * EQ . 2 ) UXK^XBC ( NPK ) 
IF<NBC.EQ*4.0R,NBC*EQ*3) UYK=YBC(NPK) 
GO TO 356 
354 CONTINUE 

NPK^NPK-NUMOP 

UXK=PX<NPK) 

UYK=PY<NPK) 

356 CONTINUE 
C 

BO 356 L=lfNNPE . 

IFCK»GT*NVPE*AND*L*GT*NVPE> GO TO 359 
NPL^^iPCIELEJrL) 

FXNPL*=SXX ( L r K > *UXK+SX Y ( L f K ) #U YK 
F YNPL=SYX ( L » K ) HtUXK+SYY < L f K > :fcU YK 
FX ( NPL ) =FX ( NPL > -FXNPL 
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F Y ( NPL > =FY < NPL ) -FYNPL 
FIX ( NPL ) =FTX < NPL > +FXNPL 
FT Y ( NPL ) =FT Y < NPL) +FYNPL 

358 CONTINUE 

359 CONTINUE 


IF<LCU.EG.O) GO TO 370 
PLACE IN LARGE SK MATRIX 


DO L=1»NNPE 
L1=NPR(NP(1ELEJfL) ) 

DO 36^ H=1»NNPE 
H1=NPR<NP(IELEJfH) ) 

IF(Ml.LT.Ll) GO TO 36A 
M2=IDIAG(liLl)+(Hl-Ll) 
IF<M2«GE.IDIAGaFLl+l)> GO TO 7009 

SKXX <H2)=SKXX<M2) +TXX < L f M > 

SKX Y ( M2 ) =SKX Y < M2 ) +TXY ( L f H ) 
SKYX<M2)=SKYX<M2>+TYX(LfM) 
SKYY(M2)=SKYY(M2) +TY Y < L f M ) 

364 CONTINUE 
366 CONTINUE 


370 CONTINUE 

ALL ELEMENTS ACCOUNTED FOR IN CURRENT TAPE SEGMENT 


FORMULATION OF BOUNDARY CONDITIONS 


DO 39S J=1fIC0MP 
J1=LIST(J) 

IFCJl.GT.NUMOP) 60 TO 395 
J2=IDIAG(1 fJ> 

C 

IF(CX(J1)4E0.0.0) FX<J1)=FX( J1)+XBC(J1) 
IF(CY( JD.EQ.O.O) FY(J1)=FY( J1)IYBC< Jl) 
NBC'=IABS(NPBC<J1)> 

C 

300 IFCNBC.LT.IO) GO TO 301 
NBC^NBC-10 

GO TO 300 

301 CONTINUE 
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392 

393 


394 


ir(Nttc.j:n*i> go to 395 


I F < SKBC * GT . 1 f 0 ) SKBC^^l * 0/ ( SKXX ( J2 > *SKBC > 

IF<NBC.EQ.3) GO TO 393 

IF(LCU*ECJ*0) GO TO 392 

SKXX< J2>^1*0/SKBC 

FX<J1)=0,0 

IFCNBC*E0*2> GO TO 395 
CONTINUE 

IF(CCU.EQtO) GO TO 394 
SKYY(J2)“1*0/SKBC 
FY< J1>=0»0 


C 

395 CONTINUE 


TRIANGUUARIZATION 


DO 450 J=lfIDOMP 
C 

J2=LIST<J) 

Jl«=IDIAGClrJ) 

IF<LCU.EQ*0> GO TO 420 
XX=*SKXX(J1> 

XY^SKXY(J1> 

YY=SKYY<J1) 

C 

SKA^XX#YY-XY*XY 

C 

IF(SKA*eQ*0.0> 60 TO 7004 
C 

SKAI^l* 0/SKA 
SRXX"+YY*SKAI 
SRXY=‘-XY*SKAI 
SRYX=+SRXY 
SRYY=fXX*SKAI 
C 

SKXX(J1)=SRXX 
SKXYCJ1)=SRXY 
SKYX(J1)=SRYX 
SKYY( J1>=SRYY 
C 

420 CONTINUE 
C 

TF(J*EQ4HSTX> go to 442 
KEND^LISTX-J 

IF(KEND*GTt<IB-l>) KEND=IB-1 

DO 440 K«1fKEND 

JPK^J*fK 

Kl-IDIACar J)+K 
K2^LIST( JPK) 

C 

IF<LCU*Ea*0) GO TO 435 
C 

SFXX^SKXX ( K1 > *SRXX*fSKYX C K1 ) JK SRYX 
SFX Y-SKXX ( K1 > *SRXY+SKYX ( Kl) *SR Y Y 
SFYX=SKXY < K1 > JUSRXX+SK YY ( K1 ) *SRYX 
SFYY=SKXY(Kl):#cSRXY*f5KYY<Kl)*SRYY 
C 

Ll=IDIAGarJ>fK“l 
L2«IDIAG(lr JPK>^1 
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c 

DO AZO L=KrKEND 
C 

Li^Ll+1 

L2=L2-M 

C 

SKXX < L2 > =SKXX < L2 > -SFXX-lfSKXX (LI) -SFX Y^t^SKYX ( LI ) 
SKXY < U2 ) ==SKXY < L2 ) -SFXXiKSKXY CLl >-SFXY#SKYY < LI ) 
SKYX C L2 ) s=SK YX < L2 ) -SFYX?f:SKXX CLl) -SFV Y*SK YX (LI) 
SKYY ( L2 ) «SKYY< L2) -SFYX^SKX Y ( LI ) -SFYY3i«SKYY ( LI > 
430 CONTINUE 


SKXX<K1>«SFXX 

SKXY<K1)=SFYX 

SKYX(K1)=SFXV 

SKYY(K1>=SFYY 


435 CONTINUE 

FX ( K2 ) =FX ( K2 > --SKXX ^ K1 ) *FX ( J2 > -SKYX ( K1 ) ;#cF Y f J2 ) 
FY CK2)=FY(K2) -SKXY (K1):|:FXCJ2) -SKYY <Kl)HiFY(J2> 

440 CONTINUE 
442 CONTINUE 


450 CONTINUE 

IFCLCU*EQ*0) GO TO 499 

WRITE< 2) SKXX r SKXY t SKYX f SKYY r SKBC 

499 CONTINUE 


DETERHINE DELF 

nELF=-l*0 
DO AlO I^lfNUMNP 

IFaAOS(NPBC(I)).NE.l) GO TO i6lO 
IF(OBS(FX(I) ) ♦GT*DELF) DELF*=ABS (FX ( I O 
IF<ABS(FYa)) *GT»DELF> DELF^ABS (FY < I ) ) 
610 CONTINUE 

BACK SUBSTITUTION 


IENr(=^NUMSEG(l) 

BO 680 I-lrlENB 

BACKSPACE 2 
BACKSPACE 1 
REAEKl) 

1 NSEGrlBrLISTXf ICOMPflELEXf HOUEXrlEHPTf lELEfNPRf LIST T HOVE r INTO 
READ C 2 ) SKXX f SKXY f SKYX r SKYY f SKBC 
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c 

DO 670 J^lrlOOMP 

Jl=lCQrtP+i^J 

J2=LIST<J1> 

J3=IDIAG<lr Jl> 

C 

FX J2 =rSKXX ( J3 ) *FX C J2 > +SKX Y ( J3 ) JJfFY ( J2 ) 

F Y J2 =SK YX ( J3 ) :«cFX ( J2 ) +SKY Y < J3 > :*:FY C J2 ) 
FX(J2)~FXJ2 
FY<J2)=FYJ2 
C 

IF ,EQ*LISTX> GO TO 670 
C 
0 

KBGN=IDIAG(liJl)+l 
J3=LISTX-J1-1 
IFCJ3*GT.IB«2) J3=IB-2 
KENB^KBGN’hJS 
C 

Kl^Jl 

DO 650 K=KBGNfKEND 

KJ=K1+1 

K2=LI5T(K1> 

FX J2=FX ( J2 ) -SKXX < K > iKFX ( K2 ) -SKX Y < K > ^FY ( K2 ) 
F Y J2“FY < J2 ) -SKYX ( K ) .KFX < K2 ) -SKY Y ( K ) *F Y < K2 ) 
FX(J2>=FXJ2 
FY<J2>=FYJ2 
650 CONTINUE 
670 CONTINUE 
C 

BACKSPACE 2 
BACKSPACE 1 
C 

680 CONTINUE 
C 

C ROTATE FX AND FY VECTORS TO X-Y AXES 

C 

C 

DELU=0 » 0 

DO 715 I^ItNUMVP 

IF(COSXXPa) .E0,l,0> GO TO 705 

C=COSXXP(I) 

S=SrJRTCliO-C^Jff2> 

UXI-+C5FCUX ( I ) +S3FJUY ( I > 

UYI=^S3):UX C I ) +C:F:UY ( I ) 

UX<D=UXI 
UYa)==UYI 
705 CONTINUE 

NBC=:CABSCNPBC<I)) 

c 

712 IF(NBC*LT.10) GO TO 713 
NBC=NBC-10 

GO TO 712 

713 CONTINUE 
C 

IF < NBC ♦ EO . ^ I OR ♦ NBC . EQ . 2 ) UX < I ) =XBC ( I > 
rF<NBC*E0.4*OR.NBC.EO*3) UY<I>=YBC( I) 
IFCABS(FX(I) ) .GT*DELU) DELU=ABS ( FX C I ) > 

IF ( ABS ( FY < I ) ) . GT * BELU ) DELU^ABS ( F Y < I ) ) 

C 
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ux<i>"Ux<i)+Kx<n 

UYa)=UY<I)+FY(I) 

IF{COSXXP<I) .EOU.OJ CO TO 715 
UXI-+CWX ( I ) -S#UY ( I > 

UYI«+S3KUX( I >+C)f(UY< I > 

ux<r>~uxi 

UY(I)^UYI 
715 COMTINUE 


IF<NPPE*EQ*D) DO TO 721 
DO 720 I=1pNUHPP 
Il-NUMVP+I 
PXCI)=PX(I)+FX<Ii> 
PY<I)=PY<I>+FY<I1) 

720 CONTINUE 

721 CONTINUE 


CALL BNDRYC 


LCU=0 

ITERATION CHECK 

CAUL SECOND (RTN) 

ITEftC=ITERC+l 
IFaTERC,EQ*l> URITE<6»6> 

URI TE C 6 f S ) INCR r ITERC r DELU f DELF r RTM 
IF<ITERC.GE,ITMAXC) GO TO 7777 
IF<INCR4EQ,0,AND.ITERC»L£.2> go to 730 
IF(DELF.LEtDFCONO) GO TO 7777 
730 CONTINUE 


IF(ITERC*LT.INCLCU(2>) GO TO 100 
INCLCUC2J»INCLCU<2)+INTLCU(2) 
LCU=1 
GO TO 100 


7001 URITE<6rl> UOLrIELEJfl 
STOP 

7002 WRITE(6r2)I 
STOP 

7004 WRITECfirlA) I r Jr J2 f J1 rXXt XY f YY 
STOP / 

7007 WRITE(<Sr4) IrNSEG 
STOP 

7009 WRITE<6r3> I r Jr KrLr Mr lELEJ 
STOP ‘ 

FORMAT STATEMENTS 
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1 FORMAT<l^H VOLUME EOUALSr ElO.SrllH IN ELEMENT, 14, 13H TAPE SEGHE 
INT, 14) 

2 FORMATt* NEGATIVE DETJ, TAPE SEGMENT*, 15) 

3 FORMAT <40H MISTAKE IN PLACEMENT IN LARGE SK MATRIX ,A15) 

4 FORMAT(14HO TAPE SEGMENT ,15, 14H LISTS NSEG AS , 15) 

5 f 0RMAT<2I10,3E10.3> 

A FORMAT < SOHO INCR ITERC DELU DELF CP TIME > 

14 F0RMAT<2SH0 SINGULARITY DURNIG LDU , 4I6,3E15.S) 

7777 CONTINUE 
RETURN 
END 
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SUBROUTINE TEMP 

1 (XORDrYORDfXBCfYBCrTBCf CXfCYrCHrTXf TV f TQr COSXXPf NPBCf NP t 

2 lELEfNPRfLISTfMOVErlNTOflDIAGr 

3 SKTTrSKXYrSKYXfSKYYf 

4 UXfUYfUTFPXrPYfIP0?FTXrFTYrFTQfSI5IIfSIGXXrSIGYYfSIGXY»SIGTHf 

5 UTlFFOrHATf 

A IDArlDBtlBCflDDrlBErlDFFrPGflDHrlDIf IDJrlDKiIBLflDMf IDNf IBOfIDP) 
C 

DIMENSION 

1 XORD< IDA> f YORD(IDA) rXBC( IDO f YBC< IDO r TBC(IDA) r 

2 CX<IDC) rCY(IDC)rCHCIDA) rTXaDC) rTY(IDC) rTQ(IDA)i 

3 COSXXP < I DC ) r NPBC ( ID A ) f NP (I DF r I DE > 

C 

CQMM0N/C2/ 

1 XMI N f XM AX jr YMIN r YM AX r NUMUP r NUMPP r NUMTP r NELMC r NELNT f NPPE 
C 

DIMENSION 

1 IELE<IDI>fNPRCIDB) rLlST<IDJ> fHOVE< IDJ> r INTO(IDJ) f IDIAG(2f IDJ) 

C 

C0MM0N/C4/ 

1 KMAX(2) 7 IBMAXC2) f NQMAXC2) rNUHSEG(2> r 

2 NSEG r I B r L ISTX 1 1 COMP r lELEX f MOVEX f I EMPT 


C0MH0N/C6/ 

1 SF(7rAr7>fUT(2f7)rNUMRPT(2)rISTRES<3> 

DIMENSION 

1 SKTT(IBL) fSKXY UDU rSKYX(IDL) rSKYY(IDL) 

C0MM0N/C8/ 

1 TIMErDTIMErDTMAXri:UMAX^ 

1 DELUrDELFrDELTft-LQr 
1 ITERCrITERTf 

1 DFCONyrDUCONV^DTCDNVfDQCONV^^ * 

1 OECTL^CTEMPr 
1 THETA F ALPHA! f TRANS r 

i INCPR r INCPU » INCPL p INTPR r INTPU r INTPL f 
1 INCLCU ( 2 > f INCLTU C 2 ) f INTLCU < 2 > r I NTL TU < 2 ) r 
1 LCUfLTUf 

1 MNIrlTMAXCrITMAXTr 
1 INCR r ITU r HOP f INTEMP r L AGEUL r IRZ 

DIMENSION 

1 UXaDOrUY(lDC)#UTCIDA>f 

2 PX(IDD)fPYCIDD)rIPQ<IDDr2) r 

3 FTX<lDC)fFTYaDC>rFTGl(IDA)f 

4 SICII{IDG>rSIGXX<IDGf3) rSIGYYaDGi.3) r SIBXY ( lDGr3) rSIGTHC IDG f3) f 

5 MAT < IDF) 

COMMON 

1 CPH<9f9)FCMH(9r9)f 
1 DNQDX<3>fDNQDY<3)r 

1 RJAC<2f2) fRJACI(2f2> fDNDX (4^ ) f DNDY(6) 


DIMENSION 
1 UTiaDB>FFQ(IDB) 
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NVPE«6 

NTPE»A 


DO no I-lrNUHTP 
UTI<I)-UT(I> 
no CONTINUE 

INCLTU<2)«INTLTU<2) 

I^'ERT*»0 


BEGIN NEU ITERATION 

130 CONTINUE 

DO lAQ I«lrNUMTP 
FTQ<I>»0*0 
FC<I>=0i0 
140 CONTINUE 

CALL BNDRYT 


IF(LTU4EQ*1) SKBC=1*0E30 
ST=TRANS 

IF(INTEHP*EQ.1> ST^O^O 
IF<ST4E040*0) DTIME«1*0 
TH-THETA 

IFCBT*EQ*0*0) TH^1*0 


IF<LTU*EQ40) go to 16i 

IEND=2*KM AX ( 2 ) -NQM AX ( 2 > 
DO 160 I^lflENB 
SKTT(I)=^0#0 

160 CONTINUE 

161 CONTINUE 


REWIND 3 
REWIND 4 


IEND=NUMSEG(2> 
DO 650 I=lfIEND 


REA0(3> 

1 NSEGflBrLISTXflCONPflELEXfMOVEXnEMpTrlELErNPRfLISTfMOVEflNTO 
IF<LTU*EGI*0> R£AD<4> SKTTt 6KXY r SKYX r SKYY r SKBC 
C 

IF<I*GT*1.AND4LTU*EQ*1) caul slide 

1 ( I ELE f NPR r LI ST f MQUE r INTO f I D I AG f SKTT r SKX Y f SKYX r SK Y Y f 

2 IDArXDBrlDCnPDflDEflDFnDGrlDHrlDIf IDJpIDKrlDLpIDHrlDNrlDQrlDP) 
C 

DO 370 J^lrlELEX 
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c 

IELEJ=IELE(J) 
HJ=MAT(IELEJ) 
RHQJ=RHO<HJfIELEJ> 
CPJ=CP(MJrIELEJ) 
RCPJ=RHQJ*CPJ 
RKX J=RKX ( M Jf lELEJ > 
RKYJ=RKY(MJ,IELEJ> 
C 

DO 210 K=lrNTPE 
DO 210 L=ltNTPE 
CPH<KrL>=0.0 
CMH<K»L)=0.0 
210 CONTINUE 


V0L=0.0 


BEGIN QUADRATURE 


KEND=NUMQPT(1> 

DO 260 K=1»KEND 

XK=0,0 

YK=0,0 

TEHPK=0.0 

RJAC<1»1)=0,0 

RJAC<tr2)s0,0 

RJAC(2fl>=0.0 

RJAC(2»2)=0.0 

DO 220 L=lrNTPE 
NPLs=NP(IELEJfL) 

XK=XK+SF ( 1 » L r K ) KXORD ( NPL ) 

YK=YK+SF ( 1 r L f K ) # YORD < NPL) 

TEMPK=TEMPK+SF <lrLfK)*(UT(NPL>+UTKNPL))/2.0 
RJAC<lrl>=RJACafl>+SF(2i'L»K)*X0RD<NPL> 
RJAC(l»2)=RJAC<lr2)+SF<3fLrK)*X0RD(NPL> 
ftJAC(2f l)=RJAC(2rl>+SF<2rLrK>#Y0RD<NPL) 
RJAC<2»2)=RJAC{2r2)+SF(3rLtK))KY0RD<NPL> 

220 CONTINUE 

DET J=R JAC < 1 r 1 ) »R JAC ( 2 1 2 ) -R JAC ( 2 1 1 ) *R JAC < 1 p 2 ) 

R JACI ( 1 » 1 ) =+R JAC < 2 » 2 ) /DET J 
R JAC I< 1 » 2 ) =-R JAC ( 1 f 2 > /DET J 
R JACI ( 2 f 1 ) =-RJAC (2,1) /DET J 
RJACI (2,2) =+RJAC ( 1 r 1 ) /DET J 

DV=DETJ 

IF(IRZ.EQ.l) DVaXKHtDETJ 
V0L=gOL+MT(lrK)#D0 


DO 235 U=1,NTPE 

DNDX<L)=RJACia,l>*SF(2,LrK)+RJACI<2,l)*SF<3,L,K) 
DNDY<L>=RJACI<l,2))KSF<2,L»K)+RJACI(2r2))KSF<3,L,K) 
23S CONTINUE 
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DO 236 L=:lf3 

L1=L 

L2*=L+3 

DN0DX<L)=RJACIClfl>#SF(7fLlFl>+RJACI(2f l)J>^SF<7»L2fl) 
DN0DY<L>^RJACI(lf2>JKSF(7ft.lFl)+RJACI(2r2)#SF(7#L2Fl> 
236 CONTINUE 


UXK"0*0 

UYK^0,0 

IF < INTEMP •EQ*i) GO TO 249 
IF(LAGEUL.EQ.l) GO TO 241 

DO 240 L’=»lfNTPE 
NPL=NP(IELEJFt> 

UXK=UXK+SF (1 f L r K ) ;»CUX ( NPL > 
UYK-UYK+SF ( 1 r L F K ) #U Y ( NPL ) 

240 CONTINUE 

241 CONTINUE 


CALCULATE VISCOUS HEATING 

IF<M0P4EQ,1) GO TO 249 
IF(IELEJ*GT*NELMC> GO TO 249 


EPSXX-0*0 

EPSYY=0*0 

EPSTH"0»0 

EPSXY=0*0 

OHGYX=^0*O 

DO 245 L^^IfNVPE 
L1=^NPCIELEJ»L> 

EPSXX«EPSXX+DNDX ( L > JKUX < L 1 ) 

EPSYY-EPSYY+DNDY (L) *UY (LI ) 

EPSX Y-EPSXY+ < DNDX ( L > *UY < LI ) +DNDY i L ) *UX < L 1 ) ) /2 ♦ 0 
PMGYX^0M6YX+< DNDY ( L ) *UX < LI ) -DNDX ( L ) JifU Y < LI ) > /2 , 0 
245 CONTINUE 

0MGXY=-0MGYX 

IF ( IRZ . EQ ♦ 1 • AND t XK * EQ • 0 * 0 > EPSTH-EPSXX 
IF < I R2 * EO • 1 ♦ AND . XK . NE . O * O ) EPSTH=UXK/XK 

GK==6(TEHPKfMI) 

IF(GK,LT.0*0> GO TO 247 

CALCULATE STRESS RATES 

DXXDT=0.0 

DYYDT=0.0 

DXYDT=0*0 

DTHDT=OtO 

DO 246 L-lr3 

DXXDT-DXXDT+DNQDX < L > JicSIGXX ( lELE J f L ) #UXK 
1 +DNQOY < L ) *S I GXX C lELE J t L ) *U VK 

1 -2 * OJKSIGXY< lELEJ tL) #OMGYX 

DYYDT=DYYDT+DNQDX (L ) *SI6Y Y < lELEJ f L > *UXK 
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1 +DNQt*Y ( L ) iHSXGYY < lELEJ r L > *UYK 

1 "2 • OJUSIGXY < lELE J f L ) JjcOMGX Y 

DXYDT=DXYDT+DNaDX(L)*SIGXY<IELeJfL)3*cUXK 
1 +DNQDY < L) :*cSIGX Y < lELE J f L ) WYK 

1 --SIQXX < lELE J . L) *OMGX Y-SIGY Y ( lELE J i L ) ;»rOMPYX 

IFCIRZ.EQ.O) GO TO 246 
riTHDT=DTHDT+DNQDX f L ) *SI6TH < lELE J » L > #UXK 
1 +DNQDY < L > )*tSIGTH < lELE J f L ) *UYK 

246 CONTINUE 

CALCULATE PLASTIC STRAIN RATES 


EPSXX-EPSXX-DXXDT/ < 2 * 0*GK ) 

EPSY Y-EPSY Y-D YYDT/ ( 2 . 0*GK ) 

EPSX Y=EPSX Y-DXYDT/ C 2 * 0*GK > 

EPSTH==EPSTH-DTHDT/(2*0*GK) 

247 CONTINUE 

CALCULATE EPSIT 

EPS 1 1= ( 2 . 0/3 , 0 ) Jit ( EPSXXiit*2+EPSYYJltiK2-f EPSTH*#2+2 . 0*EPSX Y*3|c2 > 
EPSII=SQRT<EPSII) 

CALL VI SC ( US r UT f PENLTY f NPPE • EPS 1 1 r TEHPK r XK f YK f M J > 
O=2*O*VS5|c(3t0/2,O)*<EPSII#3lt2) 


HO 248 L=1fNVPE 
Ll=NP(IELEJfL> 

FQ ( L 1 ) ( L 1 ) PUT a F K ) JKSF ( 1 r L F K ) *Q#DV3|£DT IHE 

248 CONTINUE 

249 CONTINUE 


C-0.0 

DO 250 L-lrNTPE 
DO 2S0 M^lfNTPE 

H=?WT < 1 F K ) * ( DNDX < L ) JitRKX J^DNDX ( M > +DNDY ( L ) JitRKY J*DND Y < M ) ) JlfD V 
H-H+WT <1 F K > * < RCP J* ( DNDX ( H ) JTUXK+DNDY < M > *UYK ) ) *SF ( 1 r L t K ) *DV 
IF(ST,EQ.1.0) C=WT(l»K)*(SF<lFLfK>JfcRCPJ*SF<lFHyK)>J|tDV 


CPH ( L F M ) ==CPH ( L F M > +C+HJ|fTH5*tDTIME 
IF(ST*EQ*0*0) GO TO 2S0 
CHH<LfM)=CMH(LfM) +C ‘-H«(C1.0-TH>*DTIME 

250 CONTINUE 

260 CONTINUE 

END OF VOLUME QUADRATURE 
XFCVOL.LE^O^O) 60 TO 7003 
SURFACE OUADRATURE 


DO 290 K~1f3 
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K1=2*K 

HIDSID=NP( lELEJ » K1 ) 

IFCCH(HlDSlD)*EQ»0.0«ANP*TQ(MlD5Iir)»EQ.O.0> GO TO 290 
C 

LEND=NUMnPT<2> 

PO 280 Lair LEND 

XL=^0*0 

DXDXl ^0*0 

DYDXI=0*0 

TQL^O.O 

CHL=CH<HID5ID) 

C 

Ml^Kl-2 

DO 270 M=lf3 

IF<Ml#ECi.7) Hl=l 

NPM^NP<Ic:LEJfMl> 

C 

DXDXI=nXDXI+SF(6rMfL)*X0RD<NPM) 

DYDXI=DYDXI+SF< A f M » L > *YORD < NPH) 

XL=XL+SF ( 5 f M f L > 5»c XORD < NPM > 

IF<TQ<MIDSID>,NE*0*0) TQL«TQLfSF<5rMrL)J*cTP(NPM> 

C 

270 CONTINUE 

DS=SORT <DXDXI*#2+DYDXI#*2 ) 

IF{IRZ,EG*1) DS=XL*DS 
C 

H1=K1"2 
DO 2B0 N-lf3 

IF(Mi,Eat7> 

NPNl-NP(IELEJrMl) 

C 

FQ (NPHl > =FQ < NPMl ) fWT < 2 f L > #SF< 5 r M f L > #TGL*DS*DTIME 
C 

Nl=Kl-2 
DO 280 N=ir3 
Nl-Nl+1 

IF<NltER,7) Nl=l 
NPNl=NP<IELEJfNl) 

C 

QL=WT<2FL>)»:SF<5FMfU*CHL5|cSF<5fNrL>*DS 
CPH <Ml#Nl)=CPH<MlFNi)+ QL* TH *DT I HE 
FCK NPMi ) ==FCH NPHl > +QL#DTIHE*TBC ( NPNl ) 

IF(ST*EQ.0,0) GO TO 280 
CHH ( Ml F N1 ) =CMH ( Ml t N1 > -QLilt C 1 • 0-TH > *DTIME 
C 

280 CONTINUE 
290 CONTINUE 
C 

IFCSTtE0,0> GO TO 331 
FORMULATION OF FO-CMH#UT 


DO 330 K=1fNTP£ 

NPK=NP<IELEJrK> 

DO 330 L=1fNTPE 
NPL“NP(IELEJrL) 

FQ < NPK ) ===FQ ( NPK > +CMH < K F U 3|fUT ( NPL) 
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330 CONTINUE 

331 CONTINUE 

CALL STIFF<IELEJ»1TU) 
IF<LTU.EQ.O) GO TO 370 


CALL STiFF<IELE3fITV) 


PLACE IN LARGE K-NATRIX 

DO 366 K=1»WTPE 
K1=NPR< NP t lELE J r K ) ) 

DO 366 L«1/NTPE 
Ll=NPR(NP<IELEJfL)> 
L2=IDIAG<2fKl>+(Ll-Kl) 
SKTT ( L2 > «SKTT ( L2 > ‘f-CPH ( K f L ) 
366 CONTINUE 

370 CONTINUE 


ALL ELEMENTS ACCOUNTED FOR IN CURRENT TAPE SEGMENT 


FORMULATION SOURCESf SINKS AND BOUNDARY CONDITIONS 

DO 335 J^IfICOMP 
Jl«LIST(J) 

J2^IDIAG(2f J) 

IF(CHUl) ,EQ*0*0? FQ(Jl)-FQ(Jl)*fTBC<Jl>#DTINE 
IF<NPBC(J1)»GT*0) GO TO 385 

IF(LTU*EQ,0 GO TO 384 

IF < SKBC ♦ CT . 1 . 0> SKBC= 1 * 0/ ( SKTT < J2 > *SKBC > 

SKTTi J2)=1.0/SKBC 

384 CONTINUE 
FQ<J1>=TBC<J1)/SKBC 

385 CONTINUE 

L'-D’-U DECOMPOSITION 

IF(LTU.ECI*0) GO TO 499 
C 

DO 450 J-lfICOMP 
Jl^LISKJ) 

J2“IDIAG(2fJ> 

IF<SKTT(J2>*EQ*0.0> GO TO 7001 
SRTT«1,0/SKTT(J2) 

SKTT<J2>^SRTT 

C 

IF(J*EQ.LISTX) GO TO 450 
C 

KEND=LISTX-J 

IF(KEND*GT.(IB-1)> KEND=IB-1 
C 

DO 449 K==1fKEND 
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JPK=J+K 

Kl==IDIAG<2rJPK)-K 

FAC=SRTT*SKTT(K1) 

SKTT(K1>=FAC 
XF<FAC.EQ*0) GO TO AA9 
Ll=IDIAG<2f J) 

L2=IDIAG<2f JPK)-K 
C 

DO ^48 L-1»KEND 

L1=L1+1 

L2=L2+1 

SKTT ( L2 > ==SKTT C L2 > -SKTT < L J ) #FAC 

448 CONTINUE 

449 CONTINUE 

450 CONTINUE 

WRITE ( 4 > SKTT r SKXY f SK YX » SKY Y » SKBC 
C 

499 CONTINUE 


FORWARD ELIMINATION 


DO 630 J=1tIC 0MP 
Jl^LISTCJ) 

J2-IDIAG(2f J) 

KEND=LISTX"J 
IF<KEND*EQ*0) GO TO 630 
IF(KEND*GT*IB-1) KEND=IB-1 

DO 620 K=lrKEND 
JPK=J+K 

IF(JPK*GT*LISTX> GO TO 620 
K1=LIST(JPK> 

K2=lDIAG<2r JPK>-K 
FGKKl >=FQ(Kl>-SKTT(K2)J»tFQ{ Ji > 
620 CONTINUE 

630 CONTINUE 

650 CONTINUE 

LTU»0 


BACK SUBSTITUTION 

rEND=NUMSEG(2) 

IFdEND.EO^O) IEND=1 
DO 690 I*lrIEND 
C 

BACKSPACE 3 
BACKSPACE 4 
READ<3> • 

1 NSEGtIBrLiSTXf ICOMPrIELEXfMOVEXf lEMPTrlELEfNPRfLISTrMOUEdNTO 
READC4) SKTTrSKXYrSKYXrSKYYfSKBC 
C 
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DO 680 J=lrIC0HP 

Jl^ICOHP-M-J 

J2=LIST<J1) 

FQJ2=FQ(J2) 

IF(J1*EQ.LISTX> GO TO 67? 
C 

KBGN-IDIAG(2f Jl>+i 
J3=LISTX"J1 

KEND=IDI AG < 2 r Ji ) + J3 
C 

K1=J1 

DO 675 K^KBGNfKEND 

K1==K1+1 

K2=LIST<K1> 

FCU2==FD J2-SKTT ( K J *FQ < K2 ) 
675 CONTINUE 
C 

679 CONTINUE 
rDIAGJ=IDIAG<2rJl) 

FQ < J2 ) ^FQ J2*SKTT < ID! AG J > 

680 CONTINUE 


BACKSPACE 3 
BACKSPACE 4 
690 CONTINUE 


CHANGE UTI ARRAY AND DETERMINE MAX BELT FOR CURRENT ITERATION 


DELT-0,0 * 

DO 708 I-1#NUHTP 
D=ABS<UTI(I>-FQ<I)) 
IF<n,GT*DELT> DELT=D 
UTI<I)=FQ<r> 

708 CONTINUE 


ITERATION CHECK 

CALL SECOND (RTM) 

ITERT=ITERT-fl 
IF(ITERT.EQ.l) WRITE<6f6) 
URlTE<6f5> INCRrlTERTrDELTrRTM 
IF(DELT*LE>DTCONU) GO TO 850 
IF(ITERT*GE.ITMAXT> GO TO 850 
IF<ITERT,LT*INCLTU<2)) GO TO 130 
INCLTU ( 2 > = I NCLTU ( 2 > +1 NTLTU ( 2 ) 
LTU=1 
GO TO 130 


850 CONTINUE 


CHANGE UT ARRAY AND CALCULATE MAX DELT FOR CURRENT INCREMENT 


DELT=0*0 
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DO 870 I=1,NUMTP 
D=ABS(UTKI)-UT(I) > 
IF(D.GT.DELT) DELT»D 
UT(I)-UTKI) 

870 CONTINUE 


RETURN 

ERROR MESSAGES 

7001 WRITEC&fl) I»J»J1,J2»SKTT<J2) 

1 F0RMAT(12H1 ERROR 7001 f4I5rE15.5> 

STOP 

7003 URITE<A»2) JrlELEJf VOL f <NP(IELEJ*I i) f Il=lfNTPE) 
MRITE<6 f 3) aifXORDaDfYORDdl) rIl=irNUHTP) 

2 F0RMAT(12H1 ERROR 7003r 2I5 fE10,3»6I5) 

3 FORMAT ( 17 »2E10»3) 

5 F0RHAT(2I10f2E10.3) 

6 FORMAT (40H0 INCR ITERT BELT CP TIME > 

STOP 


END 
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SUBROUTINE SLIDE 

1 ( lELE f NPR ^ LIST r MOVE f INTO r IDI AG i SKXX r SKXY f SKYX f SKY Y r 

2 IDAf IDB>IDC»IDDFlDEfIDFrIDGrIDHrIDIfIDJ^IDKrIBLpIl3MrIDNfIDOfIDP> 
C 

DIMENSION 

1 lELE(IDI) rNPRdDB) rLIST(XDJ) »HOVE ( ID J> f INTQ{ IDJ ) f iniA6<2. IDJ> 

C 

COMMON/C4/ 

1 KMAX<2> f IBMAX<2) »NQHAX(2) >NUM3EG(2) » 

2 NSEG r IB r LISTX F ICOMPf lELEX * MOVEXf lEMPT 
C 

DIMENSION 

1 SKXX<IDL) FSKXY<IDL)rSKYX<IDL>rSKYY<IDL> 

C 

COMMON/Ca/ 

1 TIHEtDTIMEfDTMAXrDUMAXf 
1 DELU^DELFfDELTfDELQf 
1 ITERCfITERTf 

1 DFCQNVtDUCONVrDTCONVfDQCDNVf 
1 VECTLrCTEMPf 
1 THETA fALPHATf TRANS f 

1 INCPR F INCPU F INCPL r INTPR f INTPU r INTPL r 
1 INCLCU( 2 ) F INCLTU < 2 ) r INTLCU < 2 ) f INTLTU < 2 ) f 
1 LCUfLTUr 

1 MNlrlTMAXCrlTMAXTf 
i INCRfITVfMOPfINTEMPfLAGEULfIRZ 

c 

c 

if(itv*eq*-i) eo to 500 
c 
c 

IEND«IDI AG< 1 f lEMPT+l ) -I 
DO 230 1=1 F TEND 
SKXX (I >-“0.0 
SKXY<I)=0.0 
SKYX<I)=0*0 

sKyYa>“0*o 
230 continue 
c 
c 

DO 399 I=1fM0VEX 
II=INT0<I) 

IFdI.EQ.O) GO TO AOQ 
IM«MOVE<I> 

C 

DO 350 J=IfMOVEX 
JI=INTO(J> 

IF(JI.EO.O) GO TO 399 
JM=MOVE<J) 

C 

IF t IADS (JM“IM>.GT.< IB-1) > GO TO 350 
C 

ITEST“+1 

IF(II.GT.JI) CO TO 250 
KI=lDIAG(lrir)+<JI“II> 

GO TO 260 
250 CONTINUE 
ITEST=-1 

KI"IDIAG(lf JI) + ai“JI) 

260 CONTINUE 
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IF(IH*GT.JM) GG TO 270 

GO TO 2B0 
270 CONTINUE 

ITEST^IT£ST3|{<-1) 
KM=^IDIAa<lr 
280 CONTINUE 

IF<KM.EQ*KI) GO TO 350 


SKXXfKI)=SKXX<KM) 

SKYY(KI>=SKYY(KN) 

IF<ITEST*LT*0) GO TO 300 

SKXY(KI)=SXXY<KM) 

SKYX(KI>«SKYX<KM) 

GO TO ZAO 

300 CONTINUE 

SKXY<KI>«’SKYX<KM) 

SKYX<KI)-SKXY(KM> 

340 CONTINUE 

SKXX<KH>^0*0 
SKXY(KH)-0.0 
SKYY<KM>=0.0 
SKYX(KM)=OtO 
350 CONTINUE 

399 CONTINUE 

400 CONTINUE 

GO TO 600 
500 CONTINUE 


NOTEr IN THIS SECTION 5KXX IS EOUIUALENT TO SKTT 


IEND=IDIAG(2rIEMPT+I> “1 
DO 530 1^1 rlEND 
SKXX(I)“0*0 
530 CONTINUE 

IBGN«IEMPT+2 

IEND«NQMAX<2) 

DO 545 I^^IBGNrlEND 
JBGN=IDIAG(2 fI)"I+ 1 
JEND= JBCN-flEMP T^I 

IF < I * GT • I BMAX< 2> ) JDGN-IDI AG ( 2r I ) -IBNAX ( 2 ) +1 
IF(JBGN.GT*JENB> GO TO 546 

DO 540 J=JBGNf JEND 
SKXX(J>=^0,0 
540 CONTINUE 

545 CONTINUE 

546 CONTINUE 
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DO 599 IslfHOVEX 
Il5=INTD<I) 

IFdl.EQ.O) GO TO 600 
IM=MOVE(I) 

DO 550 J=lfHOOEX 
JI«INTD<J) 

XF(JI,EQ.O> GO TO 599 
JM=MOVE(J) 

IF(IABS(JM-rH).OT.<IB--.>> GO TO 550 

KI=IDIAG(2»II)+<JI-II> 

KM=rDIAG<2»IM)+<JM-IM) 

IFtKM.EGt.KI) GO TO 550 
SKXX<KI>=SKXX(KH) 

SKXX<KM)=0.0 
550 CONTINUE 

599 CONTINUE 

600 CONTINUE 


RETURN 

C 

END 
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SUBROUTINE PPP 

1 (XOROrYORDrXBCfYBCfTBCrCXrCYrCHfTXrTYFlQfCOSXXPfNPBCfNPr 

2 UX^UYfUTrPXf PY^ IPQf FTXf FTYt FTOtSIGIIf SIGXXtSIGYYrSlGXV fSIGTHrMATf 

3 IDArlBBrlDCf IDDf XDErlDFr lOGriDHrlDIfXDJrIDKf IBLriDhpIDNrIDOtIDP) 

C 

C 

DIMENSION 

XORD< IDA > f YORD( IDA ) r XBC < IDC ) f YBC (IDC ) f TBC (IDA) r 
CX<IDC) rCYdDC) rCH(IDA) r TX< IDC) »TYaDC) f TQ( IDA) f 
COSXXPaDC) fNPBCaDA)rNP<IDFrIDE) 

C 

C0MMQN/C2/ 

1 XH IN r XMAX r YMIN r YMAX f NUNVP f NUHPP f NUMTP t NELMC f NELMT f NPPE 
C 

DIMENSION 

1 UX(IDC)fUYCIDC)fUT(IDA>f 
, 2 PX<IDD)fPY(IDB) F lPa<IDDF2)f 

3 FTX(IDC)FFTY<XDC>FFTCHIDA)f 

A SIGH < IDG) rSlGXXdDGfS) fSIGYY < IDGf3) fSIQXY ( IDGf 3> rSIGTH< IDG f 3) r 
5 MAKIDF) 

C 

C0MM0N/C8/ 

1 TIMEfDTIMEfDTHAXfDUMAXf 
1 DELUfDELFfDELTfDELQf 
1 ITERCfITERTf 

1 DFCONVfDUCONVfDTCONMfDQCONVf 
1 VECTLfCTEMPf 
1 THETA fALPHATf TRANS F 

1 INCPRf INCPUf INCPL f INTPR f INTPUf INTPLf 
1 I NCLCU < 2 ) f INCLTU < 2 ) V INTLCU < 2 ) p INTLTU ( 2 ) f 
1 LCUfLTUf 

1 MNIfITMAXCfITMAXTf 
1 TNCRfXTUfMOPfINTEMPfLAGEULfIRZ 

c 

DIMENSION 

1 NP3(4f^)fXC2)fYC2> 

C 

DATA NP3/.'; ^:r4f2f2.2if5t4r6f^f6f6rlf2fAf2/ 

C 

c 

IFCINCR.NE*INCPR> GO TO 200 
C 

C PRINTED OUTPUT 
C 

INCPR=INCPR+INTPR 

C 

WRITE<6f 30) TIHEFr,»;:R 

c 

c 

WRITE(6f2) 

UR V TE < A f 3 ) DELU r OELF f BELT f DEL D f ITERC f I TERT 
C 

WRITE (&f 37)D :HE 
URITE<6fl) DUMAX 
C 

WRITE(6f15) 

WniTE(Arl4) ClFXSRDa>frYORD(I>FUX<I) fUY<I)fUT<I)fFTX(1)fFTY(I>f 
1 I=1fNUNTP> 

IF(ITU.EQ,“1.ANIUM0P.EQ*+1) GO TO 200 
IFCNUMPP.EQ^O) GO TO 16X 
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URITE(Ar7) 

tiD 160 l=lfNUMPP 

IlrNUMVP+I 

miTE(6fB> IlrPXCl) rPYa>fIPa(Irl)rIPQar2) 

160 CONTINUE 

161 CPWTINUE 
C 

URlTE<Ar4) 

URITe<AF5> <IfSIGlI<I) r (SIGXXdf J) rSIGYY(Xf J) >SIGXY<If J) f J^lr3 > f 
1 I=1fNELMC> 

C 

200 CONTINUE 

PUNCHEn OUTPUT 


IF(INCR*NE*INCPU*OR*INTPU*LT*0> GO TO 205 

INCPU^INCPU+INTPU 

WRITEC7f9) INCRfTIME 
NUHNP^NUNUP 

IF ( NUHTP , GT ♦ NUK' ’P ) NUHNP=NUHTP 

WRITE<7f 10)<IfX0*lDa)rY0RD(I)rUXa>fUYa>rUT<n rI=l*NUHNP) 
20S CONTINUE 

PLOTTED OUTPUT 


IF < INCR * NE . INCPL * OR ♦ INTPL . LT ♦ 0 > RETURN 
CALL HAP<XHINFXMAXrYMlNfYMAXfO.OFl*OFO.Orl.O) 

INCPL=INCPL+INTPL 


NUHEL=NELMC 

IF<NELHT.GT»NELHC> NUMEL=NELMT 

DO 210 I=1fNUMEL 

II^NPUfI) 

I2=NP(Xf2) 

I3=NP<If3> 

J4=NP<If4> 

IP^NPdfS) 

I6=NP<If A) 

CALL POINT(XQRD<I1)»YORD<I1)) 
CALL VECTOR<XORD<I2)fYORD<I2)) 
CALL UECTOR(XORD<I3) fY0RD<I3>) 
CALL VECTOR (XORDC14>fYORDCI^)> 
CALL VECT0R{X0RD<I5>rY0R0<I5)) 
CALL VECTOR<XORDa6)FYORD(I6)> 
CALL VEGTQR(XORDai>rYORD(Il>) 
210 CONT^HUE 
CALL FRAHE 
212 CONTINUE 
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c 

c 

IF<M0P*EQ.-1) GO TO 220 
IF<ITV.EQ*-1) GO TO 480 
220 CONTINUE 
C 

c 

C PLOT OELOCITV FIELD 
C 

VHAX^O^O 

c 

no 250 I^lrNUNUP 

IF(ABSsUX(X) ) ♦GT.VMAX) VMAX=ABS(UXa ) ) 

IF < ADS ( U Y C I ) ) ♦ BT 4 VMAX ) OMAX^ABS < UY < I > > 

250 CONTINUE 
C 

IF(UHAXfNE»0.0) GO TO 340 
WRlTECAf A) 

GO TO 479 
340 CONT-NUE 
C 

PI ^ECTL/VMAX 
C 

c 

PD 350 I^l^NUHUP 

CALL LINE<XGRpa>fYORD<I)#XORD<r>+UX<I)*J?TpYORDa)+UY<I>*DT) 
350 CUKTINUE 
C 

CALL FRAME 
C 
C 

479 XF(M0P*EQ*+1) GO TO 5S0 

480 CONTINUE 
C 

C 

C PLOT ISOTHERMS 
C 

DO 500 l==lfNELMT 
:MIN==UT(NP(Ifl>) 

CMAX=CHIN 

C 

DO 420 J=2rd 
C 

IF(UT<NP<IrJ))-LT.CMIN) CMIN«=UT <NP( I f J) > 

IF<UT<NPaFj>) .GT.CMAX) CMAX=UT(NPC I r J> > 

420 CONTINUE 
C 
C 

CHK=^ ( CMAX' CMIN > /CTEMP 
IF(CHK*GT. 200*0) GO TO 7001 
C 

INT=CMIN/CTEMP 

C=INT#CTEMP 

C 

430 CONTINUE 
C 

DO 460 J=^It4 
C 

c 
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DO ASO K=lr3 
J1=NP3(J»K> 

J2=NP3(JrK+l) 

Jl^NPdf jn 
J2=NP(If J2) 

SL0PE=^UT<J2)-UT(J1> 

IFCSLOPE.EO.O) GO TO AAO 
PT=' ( C-UT < J1 > ) /SLOPE 
IF(PT*LTtO,0R*PT*GT*l*0> GO TO 450 
GO TO 445 
440 CONTINUE 

IF(UT<J1> »NE*C) 60 TO 450 
PT==J3 

445 CONTINUE 
J3^J3-M 

X<J3)=X0RDCJl)+PT:*t(XDRD(J2)-XaRD(Jl) ) 
Y C J3 ) = YORD C J1 ) +PT3*{ ( YORD ( J2 > ^YORD ( Jl> ) 
IFfJ3tEQ,2> GO TO 451 

450 CONTINUE 

451 CONTINUE 
C 

c 

IF<J3,NE*2) GO TO 460 

CALL LINE(X(l)fY<^)fXC2>rY<2>) 

460 CONTINUE 
C 

r«r+PTFMP 

IF<C*LE*CMAX> GO TO 430 
500 CONTINUE 
C 

CALL FRAME 
C 

5S0 CONTINUE 
C 

RETURN 

C 

7001 WRITE<6t 11) CMAXrCMiNrCTEMP 
STOP 


C 

C 

C 

C FORMAT STATEMENTS 
C 

1 FORMAT <28H MAXIMUM DISPLACEMENT EGUALS »E11*4 ) 

2 FORMAT (60H0 DELU DELF DELT DELQ ITERC I 

ITERT ) 

3 F0RMAT(4Et0*3f2I10> 

4 FORMATS 107H0 ELEM SIGH SI6XX1 SIGYYl SIGXYl SI 

16XX2 SIGYY2 SI6XY2 SIGXX3 SI6YY3 SIGXY3 ) 

5 F0RMATa7fE12*Sr7El0*3) 

6 FORMAT <54H0 0MAX=O*O IN PLOT ROUTINE* VELOCITY FIELD NOT PLOTTED ) 

7 F0RMAT<//f53H NODAL POINT PRS QRS IPQ 

1 f/> 

8 F0RHAT(I12r2E15*6d7f 14) 

9 FDRMAT<8H ******* t I IO tEIS *5f 33H********************#************) 

10 FORMAT<I5r2E10*3r3E18*10> 

11 FORMAT (49H0 AUTO STOPf PLOT BLOW UPf CNAX fCMINf CTEMP EQUAL ? 

1 3E10.3) 

14 F0RMAT<I7f 2E10*3»5E15*5> 

15 F0RMAT<102H0 N,P. XORD YORD UX 
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lUY UT FTX FTY ) 

30 FQRMATdH »////»13H TIME EQUALS rE15.7t/r29H NUMBER OF INCREMENT 
IS EQUALS tI6 > 

37 F0RMAT(14H0 DTIME EQUALS rElO.3) 


END 
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SUBROUTINE SHAFAC 
1 (NPPE) 

C 

COMMON/CA/ 

1 SF(7rAt7)fWT<2r7>rNUMaPT(2>rISTRES<3) 

C 

COMMON 

1 RJAC<2f 2> »RJACI(2r2) fQPT<25t3> 

C 

C 

c 

c 

c 

ISTRES<1)==5 

ISTRES<2>=^6 

ISTRES<3)=7 

NUMQPT(1)=^7 

NUMQPT(2>^3 

C 

A1=0 . 059715871789770 
B1=*0. 470142064105115 
A2«0 • 797426985353087 
B2-0 * 101286S0732345A 
C 

aPT<lfl)=l*0/340 
8PTC1f2>=1*0/3*0 
QPT<2rl)=Al 
QPT<2r2>=Bl 
QPT(3ri>=Bl 
QPT(3f2>=A1 
0PT<4f n=Bl 
0PT(4r2)-Bl 
QPT(5rl>=B2 
QPT<5f2)“A2 
QPT(6rl)=B2 
QPT(6^2>=B2 
RPT<7^1>=^A2 
QPT(7f2)=B2 
C 

WT<lfl)«0.1125 

WT ( 1 f 2 ) =0 . 066197076394253 

WT<lr3)=WT<lf2> 

MT(lr4)^UTaf2) 

WT < 1 f 5 ) =0 . 062969590272413 
WT<l»6>=WTar5) 

WT<lf7)«WT<lf5) 

C 

c 

c 

IEND=NUMQPT(1> 

DO 230 I^^lflEND 
0PT<lF3>^l*0“QPT<If l>-QPT(It2) 

230 CONTINUE 
C 

c 

c 

JEND=NUMQPT(1) 

DO 350 J^lfJENB 
DO 340 I»lf6 

SF(lflfJ)^SFN(QPT<Jrl>rOPT< Jr2>rQPT<Jf3) rl> 
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SF<2rIt J>=SFNXI<QPT<Jrl) rQPT<Jr2>fC»PT<Jr3)fI> 
SF(3fIrJ)=SFNETA<0PT(Jrl)fQPT<Jf2)fQPT(Jf3)fI> 

340 CONTINUE 

SF<4rl>J)“i *0 
IF(NPPE.EQ*1) GD TO 350 
DO 349 I*lf3 

SF(4rIrJ)=SFNP(0PT<Jrl)rQPT<Jp2) rQPT(Jr3>rI> 

349 CONTINUE 

350 i-ONTINUE 
C 

C CALCULATION SHAPE FACTOR DERI VAT lUEb FDR STRESS RATES 
C 
C 
C 

I1=ISTRES<1) 

I2=^IGTRES<2) 

I3«=ISTRES<3) 

C 

RJAC(lfl>=-0PT(Il^l)+QPT(I2rl) 

RJAC< 1 f 2>^“QPT C II f 1 )*l‘apT( I3» I > 
RJAC(2fl)=-QPT<n#2>+0PT(I2r2) 
RJAC<2r2)=-QPTair2)fQPT(I3f2) 

C 

c 

DET J:=R JAC < 1 f 1 > 3*cR JAC ( 2 f 2 ) -R JAC C 2 f 1 ) JAC < 1 f 2 > 

C 

R JACr < 1 # 1 ) =+R JAC ( 2 f 2 ) /DET J 
R JACK 1 r 2 ) =-R JAC < 1 f 2 > /DET J 
R JACI C 2 F I ) =-R JAC { 2 F 1 ) /DET J 
R JACI C 2 f 2 > =+RJAC ( 1 p 1 ) /DET J 
C 

SF<7Flrl)=-RJACI<lpl>~RJACK2fl) 

SFC7f2»l>^+RJACmFl) 

SF(7F3rl>= +RJACI(2f 1) 

C 

SF(7p4fl)=^-RJACIClr2)-RJACK2f2) 

SF<7fSFl)=+RJACiar2) 

SF<7f +RJACI(2f2> 

C 

C 

c 

C FDR SURFACE INTEGRATION 
C 

QPKlf l)==<-SQRT<0*A)-fl.0)/2t0 
OPT a r 3 ) " 1 • 0-QPT <1 r 1 > 

0PT<2p1>^0.5 

QPT<2f3>«0*5 

0PT<3{Fi>«<+SQRT<0.6>+l, 0/2.0 
QPT(3r3)sl.0-“aPT(3f 1) 

C 

UT(2rl)==S. 0/18*0 
UT(2r2)=8*0/lG.0 
WT(2r3)=S*0/l8*0 
C 

JEND=NUM0PT(2> 

DO 410 J=lfJEND 
DO 410 1=1 r 5 
11=1+4 

IF<I1*EQ*7) 11*1 
C 
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SFCSf IrJ)=£jFN(ttHT<Jf 1) rO*OFOPT<Jf3>r ID 
SF<6tIr J)=SFNXl<QPT<Jrl>f0*0fQPT<Jr3) rll) 

410 CONTINUE 


RETURN 

C 

END 
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FUMCTION SFN(XIfETAfZETAFN) 


GQ TO (20lF202f203r204r20Sf206)fN 

201 SFN=(2*0*XI-1*0):|JXI 

RETURN 

202 SFN=4.0#ETA*XI 
RETURN 

203 SFN=(2*0#ETA"1.0)#ETA 
RETURN 

20^ SFN-4.0:»CETA}|{ZETA 
RETURN 

205 SFN=(2*0*ZETA-l*0))|{Zrr<^ 

RETURN 

206 SFNM.O»XI#ZFTA 
RETURN 


END 

FUNCTION SFNXKXIfETArZETAi-N) 


GO TO (201f202F203r204F205F20A)fN 

201 SFNXI=4*0#XI“1*0 
RETURN 

202 SFNXI==4*0*ETA 
RETURN 

203 SFNXI==0*0 
RETURN 

204 SFNXI=-4.0#ETA 
RETURN 

205 SFNXI=-4t0*ZETA+l*0 
RETURN 

20A SFNXI^4*0:*fZETA“4#0*XI 
RETURN 


END 

FUNCTION SFNETA<XIfETApZETAFN> 


GO TO (201f202F203F204F265p206>fN 

201 SFNETA=0*0 
RETURN 

202 SFNETA=4^0*XI 
RETURN 

203 SFNETA=^4*0i»tETA-lt0 
RETURN 

204 SFNETA=4,0*ZETA"4.0»ETA 
RETURN 

205 SFNETA=-4*0*2ETA+1*0 
RETURN 

206 SFNETA=-4.0J;XI 
RETURN 


END 
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FUNCTION SFNP(XlFETArZETA»N> 
GO TO <201v^202t203)fN 

201 SFNP=l,0-2i0»ZETA 
RETURN 

202 SFNP=1.0-2.0HtXI 
RETURN 

203 SFNP=1.0-2.0*;ETA 
RETURN 



ro 


FUNCTION GAMX<TEMPKrXKfYKfMJ> 

GAMX-0*0 
F*-0*74#TEMPK 
R=SQRT < XK*»2+ YK**2 ) 

GAMX=^-F;rXK/R 

RETURN 

END 

C 

FUNCTION GAMY(TEHPKfXKfYKrHJ) 

GAMY^0*0 
F^-0.74*TEMPK 
R=SGRT ( XK*#2+YK#4{2 ) 

GAMY=“F3KYK/R 

RETURN 

END 

C 

FUNCTION G<TEi1PKfHn 
G=-1.0 
RETURN 
END 
C 

SUBROUT I NE VI SC ( VS r VT f PENLT Y » NPPE f EPSI I r TEMPK ^ XK ^ YK r M J ) 

VS=3*0 

VT=3.0 

PENLT Y*0.0 

JF(NPPEfEO.O) PENLTY==1000*0#VS 
RETURN 
END 
C 

SUBROUTINE HSHADJ 

RETURN 

END 

SUBROUTINE BNDRY 
RETURN 
END 
C 

SUBROUTINE BNDRYC 
RETURN 
END 
C 

SUBROUTINE BNDRYT 
RETURN 
END 
C 

FUNCTION RH0(HJf lELEJ) 

RH0=*370E+04 

RETURN 

END 

C 

FUNCTION CP(MJflELEJ) 

CP==l*2E+03 

RETURN 

END 

C 

FUNCTION RKX<HJfIELEJ> 

RKX=6*AA 
RETURN • 

END 

C 



FUNCTION RKY<MJ»IELEJ) 

RKY=&.AA 

RETURN 

END 

SUBROUTINE STIFF (I£LEJ»1TV> 

RETURN 

END 



